{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE NumDecimals #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

module Test.Cardano.Ledger.Binary.Vintage.Serialization (tests) where

import Cardano.Ledger.Binary hiding (Range)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BS.Lazy
import qualified Data.ByteString.Short as BS.Short
import Data.Int (Int32, Int64)
import Data.List.NonEmpty (NonEmpty)
import Data.Map (Map)
import Data.Set (Set)
import Data.Text (Text)
import qualified Data.Time as Time
import qualified Data.Vector as V
import Data.Word (Word16, Word32, Word64, Word8)
import Hedgehog
import qualified Hedgehog.Gen as Gen
import Hedgehog.Gen.QuickCheck (arbitrary)
import qualified Hedgehog.Range as Range
import Test.Cardano.Ledger.Binary.Arbitrary ()

{- HLINT ignore "Redundant <$>" -}

tests :: IO Bool
tests :: IO Bool
tests = Group -> IO Bool
forall (m :: * -> *). MonadIO m => Group -> m Bool
checkParallel $$(discover)

data TestStruct = TestStruct
  { TestStruct -> ()
tsUnit :: ()
  , TestStruct -> Bool
tsBool :: !Bool
  , TestStruct -> Integer
tsInteger :: !Integer
  , TestStruct -> Word
tsWord :: !Word
  , TestStruct -> Word8
tsWord8 :: !Word8
  , TestStruct -> Word16
tsWord16 :: !Word16
  , TestStruct -> Word32
tsWord32 :: !Word32
  , TestStruct -> Word64
tsWord64 :: !Word64
  , TestStruct -> Int
tsInt :: !Int
  , TestStruct -> Float
tsFloat :: !Float
  , TestStruct -> Int32
tsInt32 :: !Int32
  , TestStruct -> Int64
tsInt64 :: !Int64
  , TestStruct -> (Bool, Bool)
tsTupleBoolBool :: !(Bool, Bool)
  , TestStruct -> (Bool, Bool, Bool)
tsTupleBoolBoolBool :: !(Bool, Bool, Bool)
  , TestStruct -> (Bool, Bool, Bool, Bool)
tsTupleBoolBoolBoolBool :: !(Bool, Bool, Bool, Bool)
  , TestStruct -> ByteString
tsByteString :: !BS.ByteString
  , TestStruct -> Text
tsText :: !Text
  , TestStruct -> [Bool]
tsListBool :: ![Bool]
  , TestStruct -> Either Bool Bool
tsEitherBoolBool :: !(Either Bool Bool)
  , TestStruct -> NonEmpty Bool
tsNonEmptyBool :: !(NonEmpty Bool)
  , TestStruct -> Maybe Bool
tsMaybeBool :: !(Maybe Bool)
  , TestStruct -> Map Bool Bool
tsMapBoolBool :: !(Map Bool Bool)
  , TestStruct -> Set Bool
tsSetBool :: !(Set Bool)
  , TestStruct -> Vector Bool
tsVectorBool :: !(V.Vector Bool)
  , TestStruct -> ByteString
tsLByteString :: BS.Lazy.ByteString
  , TestStruct -> ShortByteString
tsSByteString :: BS.Short.ShortByteString
  , TestStruct -> UTCTime
tsUTCTime :: Time.UTCTime
  }
  deriving (Int -> TestStruct -> ShowS
[TestStruct] -> ShowS
TestStruct -> String
(Int -> TestStruct -> ShowS)
-> (TestStruct -> String)
-> ([TestStruct] -> ShowS)
-> Show TestStruct
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TestStruct -> ShowS
showsPrec :: Int -> TestStruct -> ShowS
$cshow :: TestStruct -> String
show :: TestStruct -> String
$cshowList :: [TestStruct] -> ShowS
showList :: [TestStruct] -> ShowS
Show, TestStruct -> TestStruct -> Bool
(TestStruct -> TestStruct -> Bool)
-> (TestStruct -> TestStruct -> Bool) -> Eq TestStruct
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TestStruct -> TestStruct -> Bool
== :: TestStruct -> TestStruct -> Bool
$c/= :: TestStruct -> TestStruct -> Bool
/= :: TestStruct -> TestStruct -> Bool
Eq)

genTestStruct :: Gen TestStruct
genTestStruct :: Gen TestStruct
genTestStruct =
  ()
-> Bool
-> Integer
-> Word
-> Word8
-> Word16
-> Word32
-> Word64
-> Int
-> Float
-> Int32
-> Int64
-> (Bool, Bool)
-> (Bool, Bool, Bool)
-> (Bool, Bool, Bool, Bool)
-> ByteString
-> Text
-> [Bool]
-> Either Bool Bool
-> NonEmpty Bool
-> Maybe Bool
-> Map Bool Bool
-> Set Bool
-> Vector Bool
-> ByteString
-> ShortByteString
-> UTCTime
-> TestStruct
TestStruct
    (()
 -> Bool
 -> Integer
 -> Word
 -> Word8
 -> Word16
 -> Word32
 -> Word64
 -> Int
 -> Float
 -> Int32
 -> Int64
 -> (Bool, Bool)
 -> (Bool, Bool, Bool)
 -> (Bool, Bool, Bool, Bool)
 -> ByteString
 -> Text
 -> [Bool]
 -> Either Bool Bool
 -> NonEmpty Bool
 -> Maybe Bool
 -> Map Bool Bool
 -> Set Bool
 -> Vector Bool
 -> ByteString
 -> ShortByteString
 -> UTCTime
 -> TestStruct)
-> GenT Identity ()
-> GenT
     Identity
     (Bool
      -> Integer
      -> Word
      -> Word8
      -> Word16
      -> Word32
      -> Word64
      -> Int
      -> Float
      -> Int32
      -> Int64
      -> (Bool, Bool)
      -> (Bool, Bool, Bool)
      -> (Bool, Bool, Bool, Bool)
      -> ByteString
      -> Text
      -> [Bool]
      -> Either Bool Bool
      -> NonEmpty Bool
      -> Maybe Bool
      -> Map Bool Bool
      -> Set Bool
      -> Vector Bool
      -> ByteString
      -> ShortByteString
      -> UTCTime
      -> TestStruct)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> () -> GenT Identity ()
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    GenT
  Identity
  (Bool
   -> Integer
   -> Word
   -> Word8
   -> Word16
   -> Word32
   -> Word64
   -> Int
   -> Float
   -> Int32
   -> Int64
   -> (Bool, Bool)
   -> (Bool, Bool, Bool)
   -> (Bool, Bool, Bool, Bool)
   -> ByteString
   -> Text
   -> [Bool]
   -> Either Bool Bool
   -> NonEmpty Bool
   -> Maybe Bool
   -> Map Bool Bool
   -> Set Bool
   -> Vector Bool
   -> ByteString
   -> ShortByteString
   -> UTCTime
   -> TestStruct)
-> GenT Identity Bool
-> GenT
     Identity
     (Integer
      -> Word
      -> Word8
      -> Word16
      -> Word32
      -> Word64
      -> Int
      -> Float
      -> Int32
      -> Int64
      -> (Bool, Bool)
      -> (Bool, Bool, Bool)
      -> (Bool, Bool, Bool, Bool)
      -> ByteString
      -> Text
      -> [Bool]
      -> Either Bool Bool
      -> NonEmpty Bool
      -> Maybe Bool
      -> Map Bool Bool
      -> Set Bool
      -> Vector Bool
      -> ByteString
      -> ShortByteString
      -> UTCTime
      -> TestStruct)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity Bool
forall (m :: * -> *). MonadGen m => m Bool
Gen.bool
    GenT
  Identity
  (Integer
   -> Word
   -> Word8
   -> Word16
   -> Word32
   -> Word64
   -> Int
   -> Float
   -> Int32
   -> Int64
   -> (Bool, Bool)
   -> (Bool, Bool, Bool)
   -> (Bool, Bool, Bool, Bool)
   -> ByteString
   -> Text
   -> [Bool]
   -> Either Bool Bool
   -> NonEmpty Bool
   -> Maybe Bool
   -> Map Bool Bool
   -> Set Bool
   -> Vector Bool
   -> ByteString
   -> ShortByteString
   -> UTCTime
   -> TestStruct)
-> GenT Identity Integer
-> GenT
     Identity
     (Word
      -> Word8
      -> Word16
      -> Word32
      -> Word64
      -> Int
      -> Float
      -> Int32
      -> Int64
      -> (Bool, Bool)
      -> (Bool, Bool, Bool)
      -> (Bool, Bool, Bool, Bool)
      -> ByteString
      -> Text
      -> [Bool]
      -> Either Bool Bool
      -> NonEmpty Bool
      -> Maybe Bool
      -> Map Bool Bool
      -> Set Bool
      -> Vector Bool
      -> ByteString
      -> ShortByteString
      -> UTCTime
      -> TestStruct)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range Integer -> GenT Identity Integer
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral (Integer -> Integer -> Integer -> Range Integer
forall a. Integral a => a -> a -> a -> Range a
Range.linearFrom Integer
0 (-Integer
1e40) Integer
1e40 :: Range Integer)
    GenT
  Identity
  (Word
   -> Word8
   -> Word16
   -> Word32
   -> Word64
   -> Int
   -> Float
   -> Int32
   -> Int64
   -> (Bool, Bool)
   -> (Bool, Bool, Bool)
   -> (Bool, Bool, Bool, Bool)
   -> ByteString
   -> Text
   -> [Bool]
   -> Either Bool Bool
   -> NonEmpty Bool
   -> Maybe Bool
   -> Map Bool Bool
   -> Set Bool
   -> Vector Bool
   -> ByteString
   -> ShortByteString
   -> UTCTime
   -> TestStruct)
-> GenT Identity Word
-> GenT
     Identity
     (Word8
      -> Word16
      -> Word32
      -> Word64
      -> Int
      -> Float
      -> Int32
      -> Int64
      -> (Bool, Bool)
      -> (Bool, Bool, Bool)
      -> (Bool, Bool, Bool, Bool)
      -> ByteString
      -> Text
      -> [Bool]
      -> Either Bool Bool
      -> NonEmpty Bool
      -> Maybe Bool
      -> Map Bool Bool
      -> Set Bool
      -> Vector Bool
      -> ByteString
      -> ShortByteString
      -> UTCTime
      -> TestStruct)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range Word -> GenT Identity Word
forall (m :: * -> *). MonadGen m => Range Word -> m Word
Gen.word Range Word
forall a. (Bounded a, Num a) => Range a
Range.constantBounded
    GenT
  Identity
  (Word8
   -> Word16
   -> Word32
   -> Word64
   -> Int
   -> Float
   -> Int32
   -> Int64
   -> (Bool, Bool)
   -> (Bool, Bool, Bool)
   -> (Bool, Bool, Bool, Bool)
   -> ByteString
   -> Text
   -> [Bool]
   -> Either Bool Bool
   -> NonEmpty Bool
   -> Maybe Bool
   -> Map Bool Bool
   -> Set Bool
   -> Vector Bool
   -> ByteString
   -> ShortByteString
   -> UTCTime
   -> TestStruct)
-> GenT Identity Word8
-> GenT
     Identity
     (Word16
      -> Word32
      -> Word64
      -> Int
      -> Float
      -> Int32
      -> Int64
      -> (Bool, Bool)
      -> (Bool, Bool, Bool)
      -> (Bool, Bool, Bool, Bool)
      -> ByteString
      -> Text
      -> [Bool]
      -> Either Bool Bool
      -> NonEmpty Bool
      -> Maybe Bool
      -> Map Bool Bool
      -> Set Bool
      -> Vector Bool
      -> ByteString
      -> ShortByteString
      -> UTCTime
      -> TestStruct)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range Word8 -> GenT Identity Word8
forall (m :: * -> *). MonadGen m => Range Word8 -> m Word8
Gen.word8 Range Word8
forall a. (Bounded a, Num a) => Range a
Range.constantBounded
    GenT
  Identity
  (Word16
   -> Word32
   -> Word64
   -> Int
   -> Float
   -> Int32
   -> Int64
   -> (Bool, Bool)
   -> (Bool, Bool, Bool)
   -> (Bool, Bool, Bool, Bool)
   -> ByteString
   -> Text
   -> [Bool]
   -> Either Bool Bool
   -> NonEmpty Bool
   -> Maybe Bool
   -> Map Bool Bool
   -> Set Bool
   -> Vector Bool
   -> ByteString
   -> ShortByteString
   -> UTCTime
   -> TestStruct)
-> GenT Identity Word16
-> GenT
     Identity
     (Word32
      -> Word64
      -> Int
      -> Float
      -> Int32
      -> Int64
      -> (Bool, Bool)
      -> (Bool, Bool, Bool)
      -> (Bool, Bool, Bool, Bool)
      -> ByteString
      -> Text
      -> [Bool]
      -> Either Bool Bool
      -> NonEmpty Bool
      -> Maybe Bool
      -> Map Bool Bool
      -> Set Bool
      -> Vector Bool
      -> ByteString
      -> ShortByteString
      -> UTCTime
      -> TestStruct)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range Word16 -> GenT Identity Word16
forall (m :: * -> *). MonadGen m => Range Word16 -> m Word16
Gen.word16 Range Word16
forall a. (Bounded a, Num a) => Range a
Range.constantBounded
    GenT
  Identity
  (Word32
   -> Word64
   -> Int
   -> Float
   -> Int32
   -> Int64
   -> (Bool, Bool)
   -> (Bool, Bool, Bool)
   -> (Bool, Bool, Bool, Bool)
   -> ByteString
   -> Text
   -> [Bool]
   -> Either Bool Bool
   -> NonEmpty Bool
   -> Maybe Bool
   -> Map Bool Bool
   -> Set Bool
   -> Vector Bool
   -> ByteString
   -> ShortByteString
   -> UTCTime
   -> TestStruct)
-> GenT Identity Word32
-> GenT
     Identity
     (Word64
      -> Int
      -> Float
      -> Int32
      -> Int64
      -> (Bool, Bool)
      -> (Bool, Bool, Bool)
      -> (Bool, Bool, Bool, Bool)
      -> ByteString
      -> Text
      -> [Bool]
      -> Either Bool Bool
      -> NonEmpty Bool
      -> Maybe Bool
      -> Map Bool Bool
      -> Set Bool
      -> Vector Bool
      -> ByteString
      -> ShortByteString
      -> UTCTime
      -> TestStruct)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range Word32 -> GenT Identity Word32
forall (m :: * -> *). MonadGen m => Range Word32 -> m Word32
Gen.word32 Range Word32
forall a. (Bounded a, Num a) => Range a
Range.constantBounded
    GenT
  Identity
  (Word64
   -> Int
   -> Float
   -> Int32
   -> Int64
   -> (Bool, Bool)
   -> (Bool, Bool, Bool)
   -> (Bool, Bool, Bool, Bool)
   -> ByteString
   -> Text
   -> [Bool]
   -> Either Bool Bool
   -> NonEmpty Bool
   -> Maybe Bool
   -> Map Bool Bool
   -> Set Bool
   -> Vector Bool
   -> ByteString
   -> ShortByteString
   -> UTCTime
   -> TestStruct)
-> GenT Identity Word64
-> GenT
     Identity
     (Int
      -> Float
      -> Int32
      -> Int64
      -> (Bool, Bool)
      -> (Bool, Bool, Bool)
      -> (Bool, Bool, Bool, Bool)
      -> ByteString
      -> Text
      -> [Bool]
      -> Either Bool Bool
      -> NonEmpty Bool
      -> Maybe Bool
      -> Map Bool Bool
      -> Set Bool
      -> Vector Bool
      -> ByteString
      -> ShortByteString
      -> UTCTime
      -> TestStruct)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range Word64 -> GenT Identity Word64
forall (m :: * -> *). MonadGen m => Range Word64 -> m Word64
Gen.word64 Range Word64
forall a. (Bounded a, Num a) => Range a
Range.constantBounded
    GenT
  Identity
  (Int
   -> Float
   -> Int32
   -> Int64
   -> (Bool, Bool)
   -> (Bool, Bool, Bool)
   -> (Bool, Bool, Bool, Bool)
   -> ByteString
   -> Text
   -> [Bool]
   -> Either Bool Bool
   -> NonEmpty Bool
   -> Maybe Bool
   -> Map Bool Bool
   -> Set Bool
   -> Vector Bool
   -> ByteString
   -> ShortByteString
   -> UTCTime
   -> TestStruct)
-> GenT Identity Int
-> GenT
     Identity
     (Float
      -> Int32
      -> Int64
      -> (Bool, Bool)
      -> (Bool, Bool, Bool)
      -> (Bool, Bool, Bool, Bool)
      -> ByteString
      -> Text
      -> [Bool]
      -> Either Bool Bool
      -> NonEmpty Bool
      -> Maybe Bool
      -> Map Bool Bool
      -> Set Bool
      -> Vector Bool
      -> ByteString
      -> ShortByteString
      -> UTCTime
      -> TestStruct)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range Int -> GenT Identity Int
forall (m :: * -> *). MonadGen m => Range Int -> m Int
Gen.int Range Int
forall a. (Bounded a, Num a) => Range a
Range.constantBounded
    GenT
  Identity
  (Float
   -> Int32
   -> Int64
   -> (Bool, Bool)
   -> (Bool, Bool, Bool)
   -> (Bool, Bool, Bool, Bool)
   -> ByteString
   -> Text
   -> [Bool]
   -> Either Bool Bool
   -> NonEmpty Bool
   -> Maybe Bool
   -> Map Bool Bool
   -> Set Bool
   -> Vector Bool
   -> ByteString
   -> ShortByteString
   -> UTCTime
   -> TestStruct)
-> GenT Identity Float
-> GenT
     Identity
     (Int32
      -> Int64
      -> (Bool, Bool)
      -> (Bool, Bool, Bool)
      -> (Bool, Bool, Bool, Bool)
      -> ByteString
      -> Text
      -> [Bool]
      -> Either Bool Bool
      -> NonEmpty Bool
      -> Maybe Bool
      -> Map Bool Bool
      -> Set Bool
      -> Vector Bool
      -> ByteString
      -> ShortByteString
      -> UTCTime
      -> TestStruct)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range Float -> GenT Identity Float
forall (m :: * -> *). MonadGen m => Range Float -> m Float
Gen.float (Float -> Float -> Range Float
forall a. a -> a -> Range a
Range.constant (-Float
1e12) Float
1e12)
    GenT
  Identity
  (Int32
   -> Int64
   -> (Bool, Bool)
   -> (Bool, Bool, Bool)
   -> (Bool, Bool, Bool, Bool)
   -> ByteString
   -> Text
   -> [Bool]
   -> Either Bool Bool
   -> NonEmpty Bool
   -> Maybe Bool
   -> Map Bool Bool
   -> Set Bool
   -> Vector Bool
   -> ByteString
   -> ShortByteString
   -> UTCTime
   -> TestStruct)
-> GenT Identity Int32
-> GenT
     Identity
     (Int64
      -> (Bool, Bool)
      -> (Bool, Bool, Bool)
      -> (Bool, Bool, Bool, Bool)
      -> ByteString
      -> Text
      -> [Bool]
      -> Either Bool Bool
      -> NonEmpty Bool
      -> Maybe Bool
      -> Map Bool Bool
      -> Set Bool
      -> Vector Bool
      -> ByteString
      -> ShortByteString
      -> UTCTime
      -> TestStruct)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range Int32 -> GenT Identity Int32
forall (m :: * -> *). MonadGen m => Range Int32 -> m Int32
Gen.int32 Range Int32
forall a. (Bounded a, Num a) => Range a
Range.constantBounded
    GenT
  Identity
  (Int64
   -> (Bool, Bool)
   -> (Bool, Bool, Bool)
   -> (Bool, Bool, Bool, Bool)
   -> ByteString
   -> Text
   -> [Bool]
   -> Either Bool Bool
   -> NonEmpty Bool
   -> Maybe Bool
   -> Map Bool Bool
   -> Set Bool
   -> Vector Bool
   -> ByteString
   -> ShortByteString
   -> UTCTime
   -> TestStruct)
-> GenT Identity Int64
-> GenT
     Identity
     ((Bool, Bool)
      -> (Bool, Bool, Bool)
      -> (Bool, Bool, Bool, Bool)
      -> ByteString
      -> Text
      -> [Bool]
      -> Either Bool Bool
      -> NonEmpty Bool
      -> Maybe Bool
      -> Map Bool Bool
      -> Set Bool
      -> Vector Bool
      -> ByteString
      -> ShortByteString
      -> UTCTime
      -> TestStruct)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range Int64 -> GenT Identity Int64
forall (m :: * -> *). MonadGen m => Range Int64 -> m Int64
Gen.int64 Range Int64
forall a. (Bounded a, Num a) => Range a
Range.constantBounded
    GenT
  Identity
  ((Bool, Bool)
   -> (Bool, Bool, Bool)
   -> (Bool, Bool, Bool, Bool)
   -> ByteString
   -> Text
   -> [Bool]
   -> Either Bool Bool
   -> NonEmpty Bool
   -> Maybe Bool
   -> Map Bool Bool
   -> Set Bool
   -> Vector Bool
   -> ByteString
   -> ShortByteString
   -> UTCTime
   -> TestStruct)
-> GenT Identity (Bool, Bool)
-> GenT
     Identity
     ((Bool, Bool, Bool)
      -> (Bool, Bool, Bool, Bool)
      -> ByteString
      -> Text
      -> [Bool]
      -> Either Bool Bool
      -> NonEmpty Bool
      -> Maybe Bool
      -> Map Bool Bool
      -> Set Bool
      -> Vector Bool
      -> ByteString
      -> ShortByteString
      -> UTCTime
      -> TestStruct)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((,) (Bool -> Bool -> (Bool, Bool))
-> GenT Identity Bool -> GenT Identity (Bool -> (Bool, Bool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity Bool
forall (m :: * -> *). MonadGen m => m Bool
Gen.bool GenT Identity (Bool -> (Bool, Bool))
-> GenT Identity Bool -> GenT Identity (Bool, Bool)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity Bool
forall (m :: * -> *). MonadGen m => m Bool
Gen.bool)
    GenT
  Identity
  ((Bool, Bool, Bool)
   -> (Bool, Bool, Bool, Bool)
   -> ByteString
   -> Text
   -> [Bool]
   -> Either Bool Bool
   -> NonEmpty Bool
   -> Maybe Bool
   -> Map Bool Bool
   -> Set Bool
   -> Vector Bool
   -> ByteString
   -> ShortByteString
   -> UTCTime
   -> TestStruct)
-> GenT Identity (Bool, Bool, Bool)
-> GenT
     Identity
     ((Bool, Bool, Bool, Bool)
      -> ByteString
      -> Text
      -> [Bool]
      -> Either Bool Bool
      -> NonEmpty Bool
      -> Maybe Bool
      -> Map Bool Bool
      -> Set Bool
      -> Vector Bool
      -> ByteString
      -> ShortByteString
      -> UTCTime
      -> TestStruct)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((,,) (Bool -> Bool -> Bool -> (Bool, Bool, Bool))
-> GenT Identity Bool
-> GenT Identity (Bool -> Bool -> (Bool, Bool, Bool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity Bool
forall (m :: * -> *). MonadGen m => m Bool
Gen.bool GenT Identity (Bool -> Bool -> (Bool, Bool, Bool))
-> GenT Identity Bool -> GenT Identity (Bool -> (Bool, Bool, Bool))
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity Bool
forall (m :: * -> *). MonadGen m => m Bool
Gen.bool GenT Identity (Bool -> (Bool, Bool, Bool))
-> GenT Identity Bool -> GenT Identity (Bool, Bool, Bool)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity Bool
forall (m :: * -> *). MonadGen m => m Bool
Gen.bool)
    GenT
  Identity
  ((Bool, Bool, Bool, Bool)
   -> ByteString
   -> Text
   -> [Bool]
   -> Either Bool Bool
   -> NonEmpty Bool
   -> Maybe Bool
   -> Map Bool Bool
   -> Set Bool
   -> Vector Bool
   -> ByteString
   -> ShortByteString
   -> UTCTime
   -> TestStruct)
-> GenT Identity (Bool, Bool, Bool, Bool)
-> GenT
     Identity
     (ByteString
      -> Text
      -> [Bool]
      -> Either Bool Bool
      -> NonEmpty Bool
      -> Maybe Bool
      -> Map Bool Bool
      -> Set Bool
      -> Vector Bool
      -> ByteString
      -> ShortByteString
      -> UTCTime
      -> TestStruct)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((,,,) (Bool -> Bool -> Bool -> Bool -> (Bool, Bool, Bool, Bool))
-> GenT Identity Bool
-> GenT Identity (Bool -> Bool -> Bool -> (Bool, Bool, Bool, Bool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity Bool
forall (m :: * -> *). MonadGen m => m Bool
Gen.bool GenT Identity (Bool -> Bool -> Bool -> (Bool, Bool, Bool, Bool))
-> GenT Identity Bool
-> GenT Identity (Bool -> Bool -> (Bool, Bool, Bool, Bool))
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity Bool
forall (m :: * -> *). MonadGen m => m Bool
Gen.bool GenT Identity (Bool -> Bool -> (Bool, Bool, Bool, Bool))
-> GenT Identity Bool
-> GenT Identity (Bool -> (Bool, Bool, Bool, Bool))
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity Bool
forall (m :: * -> *). MonadGen m => m Bool
Gen.bool GenT Identity (Bool -> (Bool, Bool, Bool, Bool))
-> GenT Identity Bool -> GenT Identity (Bool, Bool, Bool, Bool)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity Bool
forall (m :: * -> *). MonadGen m => m Bool
Gen.bool)
    GenT
  Identity
  (ByteString
   -> Text
   -> [Bool]
   -> Either Bool Bool
   -> NonEmpty Bool
   -> Maybe Bool
   -> Map Bool Bool
   -> Set Bool
   -> Vector Bool
   -> ByteString
   -> ShortByteString
   -> UTCTime
   -> TestStruct)
-> GenT Identity ByteString
-> GenT
     Identity
     (Text
      -> [Bool]
      -> Either Bool Bool
      -> NonEmpty Bool
      -> Maybe Bool
      -> Map Bool Bool
      -> Set Bool
      -> Vector Bool
      -> ByteString
      -> ShortByteString
      -> UTCTime
      -> TestStruct)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range Int -> GenT Identity ByteString
forall (m :: * -> *). MonadGen m => Range Int -> m ByteString
Gen.bytes (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
20)
    GenT
  Identity
  (Text
   -> [Bool]
   -> Either Bool Bool
   -> NonEmpty Bool
   -> Maybe Bool
   -> Map Bool Bool
   -> Set Bool
   -> Vector Bool
   -> ByteString
   -> ShortByteString
   -> UTCTime
   -> TestStruct)
-> GenT Identity Text
-> GenT
     Identity
     ([Bool]
      -> Either Bool Bool
      -> NonEmpty Bool
      -> Maybe Bool
      -> Map Bool Bool
      -> Set Bool
      -> Vector Bool
      -> ByteString
      -> ShortByteString
      -> UTCTime
      -> TestStruct)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range Int -> GenT Identity Char -> GenT Identity Text
forall (m :: * -> *). MonadGen m => Range Int -> m Char -> m Text
Gen.text (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
20) GenT Identity Char
forall (m :: * -> *). MonadGen m => m Char
Gen.unicode
    GenT
  Identity
  ([Bool]
   -> Either Bool Bool
   -> NonEmpty Bool
   -> Maybe Bool
   -> Map Bool Bool
   -> Set Bool
   -> Vector Bool
   -> ByteString
   -> ShortByteString
   -> UTCTime
   -> TestStruct)
-> GenT Identity [Bool]
-> GenT
     Identity
     (Either Bool Bool
      -> NonEmpty Bool
      -> Maybe Bool
      -> Map Bool Bool
      -> Set Bool
      -> Vector Bool
      -> ByteString
      -> ShortByteString
      -> UTCTime
      -> TestStruct)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range Int -> GenT Identity Bool -> GenT Identity [Bool]
forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list (Int -> Int -> Range Int
forall a. a -> a -> Range a
Range.constant Int
0 Int
10) GenT Identity Bool
forall (m :: * -> *). MonadGen m => m Bool
Gen.bool
    GenT
  Identity
  (Either Bool Bool
   -> NonEmpty Bool
   -> Maybe Bool
   -> Map Bool Bool
   -> Set Bool
   -> Vector Bool
   -> ByteString
   -> ShortByteString
   -> UTCTime
   -> TestStruct)
-> GenT Identity (Either Bool Bool)
-> GenT
     Identity
     (NonEmpty Bool
      -> Maybe Bool
      -> Map Bool Bool
      -> Set Bool
      -> Vector Bool
      -> ByteString
      -> ShortByteString
      -> UTCTime
      -> TestStruct)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [GenT Identity (Either Bool Bool)]
-> GenT Identity (Either Bool Bool)
forall (m :: * -> *) a. MonadGen m => [m a] -> m a
Gen.choice [Bool -> Either Bool Bool
forall a b. b -> Either a b
Right (Bool -> Either Bool Bool)
-> GenT Identity Bool -> GenT Identity (Either Bool Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity Bool
forall (m :: * -> *). MonadGen m => m Bool
Gen.bool, Bool -> Either Bool Bool
forall a b. a -> Either a b
Left (Bool -> Either Bool Bool)
-> GenT Identity Bool -> GenT Identity (Either Bool Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity Bool
forall (m :: * -> *). MonadGen m => m Bool
Gen.bool]
    GenT
  Identity
  (NonEmpty Bool
   -> Maybe Bool
   -> Map Bool Bool
   -> Set Bool
   -> Vector Bool
   -> ByteString
   -> ShortByteString
   -> UTCTime
   -> TestStruct)
-> GenT Identity (NonEmpty Bool)
-> GenT
     Identity
     (Maybe Bool
      -> Map Bool Bool
      -> Set Bool
      -> Vector Bool
      -> ByteString
      -> ShortByteString
      -> UTCTime
      -> TestStruct)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range Int -> GenT Identity Bool -> GenT Identity (NonEmpty Bool)
forall (m :: * -> *) a.
MonadGen m =>
Range Int -> m a -> m (NonEmpty a)
Gen.nonEmpty (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
1 Int
20) GenT Identity Bool
forall (m :: * -> *). MonadGen m => m Bool
Gen.bool
    GenT
  Identity
  (Maybe Bool
   -> Map Bool Bool
   -> Set Bool
   -> Vector Bool
   -> ByteString
   -> ShortByteString
   -> UTCTime
   -> TestStruct)
-> GenT Identity (Maybe Bool)
-> GenT
     Identity
     (Map Bool Bool
      -> Set Bool
      -> Vector Bool
      -> ByteString
      -> ShortByteString
      -> UTCTime
      -> TestStruct)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity Bool -> GenT Identity (Maybe Bool)
forall (m :: * -> *) a. MonadGen m => m a -> m (Maybe a)
Gen.maybe GenT Identity Bool
forall (m :: * -> *). MonadGen m => m Bool
Gen.bool
    GenT
  Identity
  (Map Bool Bool
   -> Set Bool
   -> Vector Bool
   -> ByteString
   -> ShortByteString
   -> UTCTime
   -> TestStruct)
-> GenT Identity (Map Bool Bool)
-> GenT
     Identity
     (Set Bool
      -> Vector Bool
      -> ByteString
      -> ShortByteString
      -> UTCTime
      -> TestStruct)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range Int
-> GenT Identity (Bool, Bool) -> GenT Identity (Map Bool Bool)
forall (m :: * -> *) k v.
(MonadGen m, Ord k) =>
Range Int -> m (k, v) -> m (Map k v)
Gen.map (Int -> Int -> Range Int
forall a. a -> a -> Range a
Range.constant Int
0 Int
2) ((,) (Bool -> Bool -> (Bool, Bool))
-> GenT Identity Bool -> GenT Identity (Bool -> (Bool, Bool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity Bool
forall (m :: * -> *). MonadGen m => m Bool
Gen.bool GenT Identity (Bool -> (Bool, Bool))
-> GenT Identity Bool -> GenT Identity (Bool, Bool)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity Bool
forall (m :: * -> *). MonadGen m => m Bool
Gen.bool)
    GenT
  Identity
  (Set Bool
   -> Vector Bool
   -> ByteString
   -> ShortByteString
   -> UTCTime
   -> TestStruct)
-> GenT Identity (Set Bool)
-> GenT
     Identity
     (Vector Bool
      -> ByteString -> ShortByteString -> UTCTime -> TestStruct)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range Int -> GenT Identity Bool -> GenT Identity (Set Bool)
forall (m :: * -> *) a.
(MonadGen m, Ord a) =>
Range Int -> m a -> m (Set a)
Gen.set (Int -> Int -> Range Int
forall a. a -> a -> Range a
Range.constant Int
0 Int
2) GenT Identity Bool
forall (m :: * -> *). MonadGen m => m Bool
Gen.bool
    GenT
  Identity
  (Vector Bool
   -> ByteString -> ShortByteString -> UTCTime -> TestStruct)
-> GenT Identity (Vector Bool)
-> GenT
     Identity (ByteString -> ShortByteString -> UTCTime -> TestStruct)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Bool] -> Vector Bool
forall a. [a] -> Vector a
V.fromList ([Bool] -> Vector Bool)
-> GenT Identity [Bool] -> GenT Identity (Vector Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Int -> GenT Identity Bool -> GenT Identity [Bool]
forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list (Int -> Int -> Range Int
forall a. a -> a -> Range a
Range.constant Int
0 Int
10) GenT Identity Bool
forall (m :: * -> *). MonadGen m => m Bool
Gen.bool)
    GenT
  Identity (ByteString -> ShortByteString -> UTCTime -> TestStruct)
-> GenT Identity ByteString
-> GenT Identity (ShortByteString -> UTCTime -> TestStruct)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ByteString -> ByteString
BS.Lazy.fromStrict (ByteString -> ByteString)
-> GenT Identity ByteString -> GenT Identity ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Int -> GenT Identity ByteString
forall (m :: * -> *). MonadGen m => Range Int -> m ByteString
Gen.bytes (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
20))
    GenT Identity (ShortByteString -> UTCTime -> TestStruct)
-> GenT Identity ShortByteString
-> GenT Identity (UTCTime -> TestStruct)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ByteString -> ShortByteString
BS.Short.toShort (ByteString -> ShortByteString)
-> GenT Identity ByteString -> GenT Identity ShortByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Int -> GenT Identity ByteString
forall (m :: * -> *). MonadGen m => Range Int -> m ByteString
Gen.bytes (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
20))
    GenT Identity (UTCTime -> TestStruct)
-> GenT Identity UTCTime -> Gen TestStruct
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity UTCTime
forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary

instance EncCBOR TestStruct where
  encCBOR :: TestStruct -> Encoding
encCBOR TestStruct
ts =
    Word -> Encoding
encodeListLen Word
1
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> () -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> ()
tsUnit TestStruct
ts)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Bool -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> Bool
tsBool TestStruct
ts)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Integer -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> Integer
tsInteger TestStruct
ts)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> Word
tsWord TestStruct
ts)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> Word8
tsWord8 TestStruct
ts)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word16 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> Word16
tsWord16 TestStruct
ts)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word32 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> Word32
tsWord32 TestStruct
ts)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word64 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> Word64
tsWord64 TestStruct
ts)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Int -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> Int
tsInt TestStruct
ts)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Float -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> Float
tsFloat TestStruct
ts)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Int32 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> Int32
tsInt32 TestStruct
ts)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Int64 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> Int64
tsInt64 TestStruct
ts)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (Bool, Bool) -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> (Bool, Bool)
tsTupleBoolBool TestStruct
ts)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (Bool, Bool, Bool) -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> (Bool, Bool, Bool)
tsTupleBoolBoolBool TestStruct
ts)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (Bool, Bool, Bool, Bool) -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> (Bool, Bool, Bool, Bool)
tsTupleBoolBoolBoolBool TestStruct
ts)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> ByteString
tsByteString TestStruct
ts)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Text -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> Text
tsText TestStruct
ts)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> [Bool] -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> [Bool]
tsListBool TestStruct
ts)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Either Bool Bool -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> Either Bool Bool
tsEitherBoolBool TestStruct
ts)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> NonEmpty Bool -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> NonEmpty Bool
tsNonEmptyBool TestStruct
ts)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe Bool -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> Maybe Bool
tsMaybeBool TestStruct
ts)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Map Bool Bool -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> Map Bool Bool
tsMapBoolBool TestStruct
ts)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Set Bool -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> Set Bool
tsSetBool TestStruct
ts)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Vector Bool -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> Vector Bool
tsVectorBool TestStruct
ts)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> ByteString
tsLByteString TestStruct
ts)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ShortByteString -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> ShortByteString
tsSByteString TestStruct
ts)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> UTCTime -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (TestStruct -> UTCTime
tsUTCTime TestStruct
ts)

instance DecCBOR TestStruct where
  decCBOR :: forall s. Decoder s TestStruct
decCBOR = do
    Int -> Decoder s ()
forall s. Int -> Decoder s ()
decodeListLenOf Int
1
    ()
-> Bool
-> Integer
-> Word
-> Word8
-> Word16
-> Word32
-> Word64
-> Int
-> Float
-> Int32
-> Int64
-> (Bool, Bool)
-> (Bool, Bool, Bool)
-> (Bool, Bool, Bool, Bool)
-> ByteString
-> Text
-> [Bool]
-> Either Bool Bool
-> NonEmpty Bool
-> Maybe Bool
-> Map Bool Bool
-> Set Bool
-> Vector Bool
-> ByteString
-> ShortByteString
-> UTCTime
-> TestStruct
TestStruct
      (()
 -> Bool
 -> Integer
 -> Word
 -> Word8
 -> Word16
 -> Word32
 -> Word64
 -> Int
 -> Float
 -> Int32
 -> Int64
 -> (Bool, Bool)
 -> (Bool, Bool, Bool)
 -> (Bool, Bool, Bool, Bool)
 -> ByteString
 -> Text
 -> [Bool]
 -> Either Bool Bool
 -> NonEmpty Bool
 -> Maybe Bool
 -> Map Bool Bool
 -> Set Bool
 -> Vector Bool
 -> ByteString
 -> ShortByteString
 -> UTCTime
 -> TestStruct)
-> Decoder s ()
-> Decoder
     s
     (Bool
      -> Integer
      -> Word
      -> Word8
      -> Word16
      -> Word32
      -> Word64
      -> Int
      -> Float
      -> Int32
      -> Int64
      -> (Bool, Bool)
      -> (Bool, Bool, Bool)
      -> (Bool, Bool, Bool, Bool)
      -> ByteString
      -> Text
      -> [Bool]
      -> Either Bool Bool
      -> NonEmpty Bool
      -> Maybe Bool
      -> Map Bool Bool
      -> Set Bool
      -> Vector Bool
      -> ByteString
      -> ShortByteString
      -> UTCTime
      -> TestStruct)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s ()
forall s. Decoder s ()
forall a s. DecCBOR a => Decoder s a
decCBOR
      Decoder
  s
  (Bool
   -> Integer
   -> Word
   -> Word8
   -> Word16
   -> Word32
   -> Word64
   -> Int
   -> Float
   -> Int32
   -> Int64
   -> (Bool, Bool)
   -> (Bool, Bool, Bool)
   -> (Bool, Bool, Bool, Bool)
   -> ByteString
   -> Text
   -> [Bool]
   -> Either Bool Bool
   -> NonEmpty Bool
   -> Maybe Bool
   -> Map Bool Bool
   -> Set Bool
   -> Vector Bool
   -> ByteString
   -> ShortByteString
   -> UTCTime
   -> TestStruct)
-> Decoder s Bool
-> Decoder
     s
     (Integer
      -> Word
      -> Word8
      -> Word16
      -> Word32
      -> Word64
      -> Int
      -> Float
      -> Int32
      -> Int64
      -> (Bool, Bool)
      -> (Bool, Bool, Bool)
      -> (Bool, Bool, Bool, Bool)
      -> ByteString
      -> Text
      -> [Bool]
      -> Either Bool Bool
      -> NonEmpty Bool
      -> Maybe Bool
      -> Map Bool Bool
      -> Set Bool
      -> Vector Bool
      -> ByteString
      -> ShortByteString
      -> UTCTime
      -> TestStruct)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Bool
forall s. Decoder s Bool
forall a s. DecCBOR a => Decoder s a
decCBOR
      Decoder
  s
  (Integer
   -> Word
   -> Word8
   -> Word16
   -> Word32
   -> Word64
   -> Int
   -> Float
   -> Int32
   -> Int64
   -> (Bool, Bool)
   -> (Bool, Bool, Bool)
   -> (Bool, Bool, Bool, Bool)
   -> ByteString
   -> Text
   -> [Bool]
   -> Either Bool Bool
   -> NonEmpty Bool
   -> Maybe Bool
   -> Map Bool Bool
   -> Set Bool
   -> Vector Bool
   -> ByteString
   -> ShortByteString
   -> UTCTime
   -> TestStruct)
-> Decoder s Integer
-> Decoder
     s
     (Word
      -> Word8
      -> Word16
      -> Word32
      -> Word64
      -> Int
      -> Float
      -> Int32
      -> Int64
      -> (Bool, Bool)
      -> (Bool, Bool, Bool)
      -> (Bool, Bool, Bool, Bool)
      -> ByteString
      -> Text
      -> [Bool]
      -> Either Bool Bool
      -> NonEmpty Bool
      -> Maybe Bool
      -> Map Bool Bool
      -> Set Bool
      -> Vector Bool
      -> ByteString
      -> ShortByteString
      -> UTCTime
      -> TestStruct)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Integer
forall s. Decoder s Integer
forall a s. DecCBOR a => Decoder s a
decCBOR
      Decoder
  s
  (Word
   -> Word8
   -> Word16
   -> Word32
   -> Word64
   -> Int
   -> Float
   -> Int32
   -> Int64
   -> (Bool, Bool)
   -> (Bool, Bool, Bool)
   -> (Bool, Bool, Bool, Bool)
   -> ByteString
   -> Text
   -> [Bool]
   -> Either Bool Bool
   -> NonEmpty Bool
   -> Maybe Bool
   -> Map Bool Bool
   -> Set Bool
   -> Vector Bool
   -> ByteString
   -> ShortByteString
   -> UTCTime
   -> TestStruct)
-> Decoder s Word
-> Decoder
     s
     (Word8
      -> Word16
      -> Word32
      -> Word64
      -> Int
      -> Float
      -> Int32
      -> Int64
      -> (Bool, Bool)
      -> (Bool, Bool, Bool)
      -> (Bool, Bool, Bool, Bool)
      -> ByteString
      -> Text
      -> [Bool]
      -> Either Bool Bool
      -> NonEmpty Bool
      -> Maybe Bool
      -> Map Bool Bool
      -> Set Bool
      -> Vector Bool
      -> ByteString
      -> ShortByteString
      -> UTCTime
      -> TestStruct)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Word
forall s. Decoder s Word
forall a s. DecCBOR a => Decoder s a
decCBOR
      Decoder
  s
  (Word8
   -> Word16
   -> Word32
   -> Word64
   -> Int
   -> Float
   -> Int32
   -> Int64
   -> (Bool, Bool)
   -> (Bool, Bool, Bool)
   -> (Bool, Bool, Bool, Bool)
   -> ByteString
   -> Text
   -> [Bool]
   -> Either Bool Bool
   -> NonEmpty Bool
   -> Maybe Bool
   -> Map Bool Bool
   -> Set Bool
   -> Vector Bool
   -> ByteString
   -> ShortByteString
   -> UTCTime
   -> TestStruct)
-> Decoder s Word8
-> Decoder
     s
     (Word16
      -> Word32
      -> Word64
      -> Int
      -> Float
      -> Int32
      -> Int64
      -> (Bool, Bool)
      -> (Bool, Bool, Bool)
      -> (Bool, Bool, Bool, Bool)
      -> ByteString
      -> Text
      -> [Bool]
      -> Either Bool Bool
      -> NonEmpty Bool
      -> Maybe Bool
      -> Map Bool Bool
      -> Set Bool
      -> Vector Bool
      -> ByteString
      -> ShortByteString
      -> UTCTime
      -> TestStruct)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Word8
forall s. Decoder s Word8
forall a s. DecCBOR a => Decoder s a
decCBOR
      Decoder
  s
  (Word16
   -> Word32
   -> Word64
   -> Int
   -> Float
   -> Int32
   -> Int64
   -> (Bool, Bool)
   -> (Bool, Bool, Bool)
   -> (Bool, Bool, Bool, Bool)
   -> ByteString
   -> Text
   -> [Bool]
   -> Either Bool Bool
   -> NonEmpty Bool
   -> Maybe Bool
   -> Map Bool Bool
   -> Set Bool
   -> Vector Bool
   -> ByteString
   -> ShortByteString
   -> UTCTime
   -> TestStruct)
-> Decoder s Word16
-> Decoder
     s
     (Word32
      -> Word64
      -> Int
      -> Float
      -> Int32
      -> Int64
      -> (Bool, Bool)
      -> (Bool, Bool, Bool)
      -> (Bool, Bool, Bool, Bool)
      -> ByteString
      -> Text
      -> [Bool]
      -> Either Bool Bool
      -> NonEmpty Bool
      -> Maybe Bool
      -> Map Bool Bool
      -> Set Bool
      -> Vector Bool
      -> ByteString
      -> ShortByteString
      -> UTCTime
      -> TestStruct)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Word16
forall s. Decoder s Word16
forall a s. DecCBOR a => Decoder s a
decCBOR
      Decoder
  s
  (Word32
   -> Word64
   -> Int
   -> Float
   -> Int32
   -> Int64
   -> (Bool, Bool)
   -> (Bool, Bool, Bool)
   -> (Bool, Bool, Bool, Bool)
   -> ByteString
   -> Text
   -> [Bool]
   -> Either Bool Bool
   -> NonEmpty Bool
   -> Maybe Bool
   -> Map Bool Bool
   -> Set Bool
   -> Vector Bool
   -> ByteString
   -> ShortByteString
   -> UTCTime
   -> TestStruct)
-> Decoder s Word32
-> Decoder
     s
     (Word64
      -> Int
      -> Float
      -> Int32
      -> Int64
      -> (Bool, Bool)
      -> (Bool, Bool, Bool)
      -> (Bool, Bool, Bool, Bool)
      -> ByteString
      -> Text
      -> [Bool]
      -> Either Bool Bool
      -> NonEmpty Bool
      -> Maybe Bool
      -> Map Bool Bool
      -> Set Bool
      -> Vector Bool
      -> ByteString
      -> ShortByteString
      -> UTCTime
      -> TestStruct)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Word32
forall s. Decoder s Word32
forall a s. DecCBOR a => Decoder s a
decCBOR
      Decoder
  s
  (Word64
   -> Int
   -> Float
   -> Int32
   -> Int64
   -> (Bool, Bool)
   -> (Bool, Bool, Bool)
   -> (Bool, Bool, Bool, Bool)
   -> ByteString
   -> Text
   -> [Bool]
   -> Either Bool Bool
   -> NonEmpty Bool
   -> Maybe Bool
   -> Map Bool Bool
   -> Set Bool
   -> Vector Bool
   -> ByteString
   -> ShortByteString
   -> UTCTime
   -> TestStruct)
-> Decoder s Word64
-> Decoder
     s
     (Int
      -> Float
      -> Int32
      -> Int64
      -> (Bool, Bool)
      -> (Bool, Bool, Bool)
      -> (Bool, Bool, Bool, Bool)
      -> ByteString
      -> Text
      -> [Bool]
      -> Either Bool Bool
      -> NonEmpty Bool
      -> Maybe Bool
      -> Map Bool Bool
      -> Set Bool
      -> Vector Bool
      -> ByteString
      -> ShortByteString
      -> UTCTime
      -> TestStruct)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Word64
forall s. Decoder s Word64
forall a s. DecCBOR a => Decoder s a
decCBOR
      Decoder
  s
  (Int
   -> Float
   -> Int32
   -> Int64
   -> (Bool, Bool)
   -> (Bool, Bool, Bool)
   -> (Bool, Bool, Bool, Bool)
   -> ByteString
   -> Text
   -> [Bool]
   -> Either Bool Bool
   -> NonEmpty Bool
   -> Maybe Bool
   -> Map Bool Bool
   -> Set Bool
   -> Vector Bool
   -> ByteString
   -> ShortByteString
   -> UTCTime
   -> TestStruct)
-> Decoder s Int
-> Decoder
     s
     (Float
      -> Int32
      -> Int64
      -> (Bool, Bool)
      -> (Bool, Bool, Bool)
      -> (Bool, Bool, Bool, Bool)
      -> ByteString
      -> Text
      -> [Bool]
      -> Either Bool Bool
      -> NonEmpty Bool
      -> Maybe Bool
      -> Map Bool Bool
      -> Set Bool
      -> Vector Bool
      -> ByteString
      -> ShortByteString
      -> UTCTime
      -> TestStruct)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Int
forall s. Decoder s Int
forall a s. DecCBOR a => Decoder s a
decCBOR
      Decoder
  s
  (Float
   -> Int32
   -> Int64
   -> (Bool, Bool)
   -> (Bool, Bool, Bool)
   -> (Bool, Bool, Bool, Bool)
   -> ByteString
   -> Text
   -> [Bool]
   -> Either Bool Bool
   -> NonEmpty Bool
   -> Maybe Bool
   -> Map Bool Bool
   -> Set Bool
   -> Vector Bool
   -> ByteString
   -> ShortByteString
   -> UTCTime
   -> TestStruct)
-> Decoder s Float
-> Decoder
     s
     (Int32
      -> Int64
      -> (Bool, Bool)
      -> (Bool, Bool, Bool)
      -> (Bool, Bool, Bool, Bool)
      -> ByteString
      -> Text
      -> [Bool]
      -> Either Bool Bool
      -> NonEmpty Bool
      -> Maybe Bool
      -> Map Bool Bool
      -> Set Bool
      -> Vector Bool
      -> ByteString
      -> ShortByteString
      -> UTCTime
      -> TestStruct)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Float
forall s. Decoder s Float
forall a s. DecCBOR a => Decoder s a
decCBOR
      Decoder
  s
  (Int32
   -> Int64
   -> (Bool, Bool)
   -> (Bool, Bool, Bool)
   -> (Bool, Bool, Bool, Bool)
   -> ByteString
   -> Text
   -> [Bool]
   -> Either Bool Bool
   -> NonEmpty Bool
   -> Maybe Bool
   -> Map Bool Bool
   -> Set Bool
   -> Vector Bool
   -> ByteString
   -> ShortByteString
   -> UTCTime
   -> TestStruct)
-> Decoder s Int32
-> Decoder
     s
     (Int64
      -> (Bool, Bool)
      -> (Bool, Bool, Bool)
      -> (Bool, Bool, Bool, Bool)
      -> ByteString
      -> Text
      -> [Bool]
      -> Either Bool Bool
      -> NonEmpty Bool
      -> Maybe Bool
      -> Map Bool Bool
      -> Set Bool
      -> Vector Bool
      -> ByteString
      -> ShortByteString
      -> UTCTime
      -> TestStruct)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Int32
forall s. Decoder s Int32
forall a s. DecCBOR a => Decoder s a
decCBOR
      Decoder
  s
  (Int64
   -> (Bool, Bool)
   -> (Bool, Bool, Bool)
   -> (Bool, Bool, Bool, Bool)
   -> ByteString
   -> Text
   -> [Bool]
   -> Either Bool Bool
   -> NonEmpty Bool
   -> Maybe Bool
   -> Map Bool Bool
   -> Set Bool
   -> Vector Bool
   -> ByteString
   -> ShortByteString
   -> UTCTime
   -> TestStruct)
-> Decoder s Int64
-> Decoder
     s
     ((Bool, Bool)
      -> (Bool, Bool, Bool)
      -> (Bool, Bool, Bool, Bool)
      -> ByteString
      -> Text
      -> [Bool]
      -> Either Bool Bool
      -> NonEmpty Bool
      -> Maybe Bool
      -> Map Bool Bool
      -> Set Bool
      -> Vector Bool
      -> ByteString
      -> ShortByteString
      -> UTCTime
      -> TestStruct)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Int64
forall s. Decoder s Int64
forall a s. DecCBOR a => Decoder s a
decCBOR
      Decoder
  s
  ((Bool, Bool)
   -> (Bool, Bool, Bool)
   -> (Bool, Bool, Bool, Bool)
   -> ByteString
   -> Text
   -> [Bool]
   -> Either Bool Bool
   -> NonEmpty Bool
   -> Maybe Bool
   -> Map Bool Bool
   -> Set Bool
   -> Vector Bool
   -> ByteString
   -> ShortByteString
   -> UTCTime
   -> TestStruct)
-> Decoder s (Bool, Bool)
-> Decoder
     s
     ((Bool, Bool, Bool)
      -> (Bool, Bool, Bool, Bool)
      -> ByteString
      -> Text
      -> [Bool]
      -> Either Bool Bool
      -> NonEmpty Bool
      -> Maybe Bool
      -> Map Bool Bool
      -> Set Bool
      -> Vector Bool
      -> ByteString
      -> ShortByteString
      -> UTCTime
      -> TestStruct)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Bool, Bool)
forall s. Decoder s (Bool, Bool)
forall a s. DecCBOR a => Decoder s a
decCBOR
      Decoder
  s
  ((Bool, Bool, Bool)
   -> (Bool, Bool, Bool, Bool)
   -> ByteString
   -> Text
   -> [Bool]
   -> Either Bool Bool
   -> NonEmpty Bool
   -> Maybe Bool
   -> Map Bool Bool
   -> Set Bool
   -> Vector Bool
   -> ByteString
   -> ShortByteString
   -> UTCTime
   -> TestStruct)
-> Decoder s (Bool, Bool, Bool)
-> Decoder
     s
     ((Bool, Bool, Bool, Bool)
      -> ByteString
      -> Text
      -> [Bool]
      -> Either Bool Bool
      -> NonEmpty Bool
      -> Maybe Bool
      -> Map Bool Bool
      -> Set Bool
      -> Vector Bool
      -> ByteString
      -> ShortByteString
      -> UTCTime
      -> TestStruct)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Bool, Bool, Bool)
forall s. Decoder s (Bool, Bool, Bool)
forall a s. DecCBOR a => Decoder s a
decCBOR
      Decoder
  s
  ((Bool, Bool, Bool, Bool)
   -> ByteString
   -> Text
   -> [Bool]
   -> Either Bool Bool
   -> NonEmpty Bool
   -> Maybe Bool
   -> Map Bool Bool
   -> Set Bool
   -> Vector Bool
   -> ByteString
   -> ShortByteString
   -> UTCTime
   -> TestStruct)
-> Decoder s (Bool, Bool, Bool, Bool)
-> Decoder
     s
     (ByteString
      -> Text
      -> [Bool]
      -> Either Bool Bool
      -> NonEmpty Bool
      -> Maybe Bool
      -> Map Bool Bool
      -> Set Bool
      -> Vector Bool
      -> ByteString
      -> ShortByteString
      -> UTCTime
      -> TestStruct)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Bool, Bool, Bool, Bool)
forall s. Decoder s (Bool, Bool, Bool, Bool)
forall a s. DecCBOR a => Decoder s a
decCBOR
      Decoder
  s
  (ByteString
   -> Text
   -> [Bool]
   -> Either Bool Bool
   -> NonEmpty Bool
   -> Maybe Bool
   -> Map Bool Bool
   -> Set Bool
   -> Vector Bool
   -> ByteString
   -> ShortByteString
   -> UTCTime
   -> TestStruct)
-> Decoder s ByteString
-> Decoder
     s
     (Text
      -> [Bool]
      -> Either Bool Bool
      -> NonEmpty Bool
      -> Maybe Bool
      -> Map Bool Bool
      -> Set Bool
      -> Vector Bool
      -> ByteString
      -> ShortByteString
      -> UTCTime
      -> TestStruct)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s ByteString
forall s. Decoder s ByteString
forall a s. DecCBOR a => Decoder s a
decCBOR
      Decoder
  s
  (Text
   -> [Bool]
   -> Either Bool Bool
   -> NonEmpty Bool
   -> Maybe Bool
   -> Map Bool Bool
   -> Set Bool
   -> Vector Bool
   -> ByteString
   -> ShortByteString
   -> UTCTime
   -> TestStruct)
-> Decoder s Text
-> Decoder
     s
     ([Bool]
      -> Either Bool Bool
      -> NonEmpty Bool
      -> Maybe Bool
      -> Map Bool Bool
      -> Set Bool
      -> Vector Bool
      -> ByteString
      -> ShortByteString
      -> UTCTime
      -> TestStruct)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Text
forall s. Decoder s Text
forall a s. DecCBOR a => Decoder s a
decCBOR
      Decoder
  s
  ([Bool]
   -> Either Bool Bool
   -> NonEmpty Bool
   -> Maybe Bool
   -> Map Bool Bool
   -> Set Bool
   -> Vector Bool
   -> ByteString
   -> ShortByteString
   -> UTCTime
   -> TestStruct)
-> Decoder s [Bool]
-> Decoder
     s
     (Either Bool Bool
      -> NonEmpty Bool
      -> Maybe Bool
      -> Map Bool Bool
      -> Set Bool
      -> Vector Bool
      -> ByteString
      -> ShortByteString
      -> UTCTime
      -> TestStruct)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s [Bool]
forall s. Decoder s [Bool]
forall a s. DecCBOR a => Decoder s a
decCBOR
      Decoder
  s
  (Either Bool Bool
   -> NonEmpty Bool
   -> Maybe Bool
   -> Map Bool Bool
   -> Set Bool
   -> Vector Bool
   -> ByteString
   -> ShortByteString
   -> UTCTime
   -> TestStruct)
-> Decoder s (Either Bool Bool)
-> Decoder
     s
     (NonEmpty Bool
      -> Maybe Bool
      -> Map Bool Bool
      -> Set Bool
      -> Vector Bool
      -> ByteString
      -> ShortByteString
      -> UTCTime
      -> TestStruct)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Either Bool Bool)
forall s. Decoder s (Either Bool Bool)
forall a s. DecCBOR a => Decoder s a
decCBOR
      Decoder
  s
  (NonEmpty Bool
   -> Maybe Bool
   -> Map Bool Bool
   -> Set Bool
   -> Vector Bool
   -> ByteString
   -> ShortByteString
   -> UTCTime
   -> TestStruct)
-> Decoder s (NonEmpty Bool)
-> Decoder
     s
     (Maybe Bool
      -> Map Bool Bool
      -> Set Bool
      -> Vector Bool
      -> ByteString
      -> ShortByteString
      -> UTCTime
      -> TestStruct)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (NonEmpty Bool)
forall s. Decoder s (NonEmpty Bool)
forall a s. DecCBOR a => Decoder s a
decCBOR
      Decoder
  s
  (Maybe Bool
   -> Map Bool Bool
   -> Set Bool
   -> Vector Bool
   -> ByteString
   -> ShortByteString
   -> UTCTime
   -> TestStruct)
-> Decoder s (Maybe Bool)
-> Decoder
     s
     (Map Bool Bool
      -> Set Bool
      -> Vector Bool
      -> ByteString
      -> ShortByteString
      -> UTCTime
      -> TestStruct)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe Bool)
forall s. Decoder s (Maybe Bool)
forall a s. DecCBOR a => Decoder s a
decCBOR
      Decoder
  s
  (Map Bool Bool
   -> Set Bool
   -> Vector Bool
   -> ByteString
   -> ShortByteString
   -> UTCTime
   -> TestStruct)
-> Decoder s (Map Bool Bool)
-> Decoder
     s
     (Set Bool
      -> Vector Bool
      -> ByteString
      -> ShortByteString
      -> UTCTime
      -> TestStruct)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Map Bool Bool)
forall s. Decoder s (Map Bool Bool)
forall a s. DecCBOR a => Decoder s a
decCBOR
      Decoder
  s
  (Set Bool
   -> Vector Bool
   -> ByteString
   -> ShortByteString
   -> UTCTime
   -> TestStruct)
-> Decoder s (Set Bool)
-> Decoder
     s
     (Vector Bool
      -> ByteString -> ShortByteString -> UTCTime -> TestStruct)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Set Bool)
forall s. Decoder s (Set Bool)
forall a s. DecCBOR a => Decoder s a
decCBOR
      Decoder
  s
  (Vector Bool
   -> ByteString -> ShortByteString -> UTCTime -> TestStruct)
-> Decoder s (Vector Bool)
-> Decoder
     s (ByteString -> ShortByteString -> UTCTime -> TestStruct)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Vector Bool)
forall s. Decoder s (Vector Bool)
forall a s. DecCBOR a => Decoder s a
decCBOR
      Decoder s (ByteString -> ShortByteString -> UTCTime -> TestStruct)
-> Decoder s ByteString
-> Decoder s (ShortByteString -> UTCTime -> TestStruct)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s ByteString
forall s. Decoder s ByteString
forall a s. DecCBOR a => Decoder s a
decCBOR
      Decoder s (ShortByteString -> UTCTime -> TestStruct)
-> Decoder s ShortByteString -> Decoder s (UTCTime -> TestStruct)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s ShortByteString
forall s. Decoder s ShortByteString
forall a s. DecCBOR a => Decoder s a
decCBOR
      Decoder s (UTCTime -> TestStruct)
-> Decoder s UTCTime -> Decoder s TestStruct
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s UTCTime
forall s. Decoder s UTCTime
forall a s. DecCBOR a => Decoder s a
decCBOR

prop_roundTripSerialize' :: Property
prop_roundTripSerialize' :: Property
prop_roundTripSerialize' = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  TestStruct
ts <- Gen TestStruct -> PropertyT IO TestStruct
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen TestStruct
genTestStruct
  (Version -> ByteString -> TestStruct
forall a. DecCBOR a => Version -> ByteString -> a
unsafeDeserialize' Version
byronProtVer (ByteString -> TestStruct)
-> (TestStruct -> ByteString) -> TestStruct -> TestStruct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> TestStruct -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
serialize' Version
byronProtVer (TestStruct -> TestStruct) -> TestStruct -> TestStruct
forall a b. (a -> b) -> a -> b
$ TestStruct
ts) TestStruct -> TestStruct -> PropertyT IO ()
forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== TestStruct
ts

prop_roundTripEncodeNestedCbor :: Property
prop_roundTripEncodeNestedCbor :: Property
prop_roundTripEncodeNestedCbor = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  TestStruct
ts <- Gen TestStruct -> PropertyT IO TestStruct
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll Gen TestStruct
genTestStruct
  let encoded :: ByteString
encoded = Version -> Encoding -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
serialize Version
byronProtVer (Encoding -> ByteString)
-> (TestStruct -> Encoding) -> TestStruct -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestStruct -> Encoding
forall a. EncCBOR a => a -> Encoding
encodeNestedCbor (TestStruct -> ByteString) -> TestStruct -> ByteString
forall a b. (a -> b) -> a -> b
$ TestStruct
ts
  Version
-> Text
-> (forall s. Decoder s TestStruct)
-> ByteString
-> Either DecoderError TestStruct
forall a.
Version
-> Text
-> (forall s. Decoder s a)
-> ByteString
-> Either DecoderError a
decodeFullDecoder Version
byronProtVer Text
"" Decoder s TestStruct
forall s. Decoder s TestStruct
forall a s. DecCBOR a => Decoder s a
decodeNestedCbor ByteString
encoded Either DecoderError TestStruct
-> Either DecoderError TestStruct -> PropertyT IO ()
forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
=== TestStruct -> Either DecoderError TestStruct
forall a b. b -> Either a b
Right TestStruct
ts

prop_decodeContainerSkelWithReplicate :: Property
prop_decodeContainerSkelWithReplicate :: Property
prop_decodeContainerSkelWithReplicate = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$
  Bool -> PropertyT IO ()
forall (m :: * -> *). (MonadTest m, HasCallStack) => Bool -> m ()
assert (Bool -> PropertyT IO ()) -> Bool -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ case Encoding -> Either DecoderError (Vector ())
decode Encoding
vec of
    Right Vector ()
_ -> Bool
True
    Either DecoderError (Vector ())
_ -> Bool
False
  where
    decode :: Encoding -> Either DecoderError (V.Vector ())
    decode :: Encoding -> Either DecoderError (Vector ())
decode Encoding
enc = Version -> ByteString -> Either DecoderError (Vector ())
forall a.
DecCBOR a =>
Version -> ByteString -> Either DecoderError a
decodeFull Version
byronProtVer (Version -> Encoding -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
serialize Version
byronProtVer Encoding
enc)

    vec :: Encoding
vec = Word -> Encoding
encodeListLen Word
4097 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat (Int -> Encoding -> [Encoding]
forall a. Int -> a -> [a]
replicate Int
4097 Encoding
encodeNull)