{-# LANGUAGE DeriveGeneric       #-}
{-# LANGUAGE DeriveTraversable   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}

module Data.Avro.EitherN where

import           Data.Avro
import           Data.Avro.Encoding.FromAvro  (FromAvro (..))
import qualified Data.Avro.Encoding.FromAvro  as AV
import           Data.Avro.Encoding.ToAvro    (ToAvro (..))
import           Data.Avro.Internal.EncodeRaw (putI)
import           Data.Avro.Schema.Schema      as S
import           Data.Bifoldable              (Bifoldable (..))
import           Data.Bifunctor               (Bifunctor (..))
import           Data.Bitraversable           (Bitraversable (..))
import           Data.ByteString.Builder      (Builder)
import           Data.List.NonEmpty
import           Data.Tagged
import qualified Data.Vector                  as V
import           GHC.Generics                 (Generic)

data Either3 a b c = E3_1 a | E3_2 b | E3_3 c deriving (Either3 a b c -> Either3 a b c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b c.
(Eq a, Eq b, Eq c) =>
Either3 a b c -> Either3 a b c -> Bool
/= :: Either3 a b c -> Either3 a b c -> Bool
$c/= :: forall a b c.
(Eq a, Eq b, Eq c) =>
Either3 a b c -> Either3 a b c -> Bool
== :: Either3 a b c -> Either3 a b c -> Bool
$c== :: forall a b c.
(Eq a, Eq b, Eq c) =>
Either3 a b c -> Either3 a b c -> Bool
Eq, Either3 a b c -> Either3 a b c -> Bool
Either3 a b c -> Either3 a b c -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a} {b} {c}. (Ord a, Ord b, Ord c) => Eq (Either3 a b c)
forall a b c.
(Ord a, Ord b, Ord c) =>
Either3 a b c -> Either3 a b c -> Bool
forall a b c.
(Ord a, Ord b, Ord c) =>
Either3 a b c -> Either3 a b c -> Ordering
forall a b c.
(Ord a, Ord b, Ord c) =>
Either3 a b c -> Either3 a b c -> Either3 a b c
min :: Either3 a b c -> Either3 a b c -> Either3 a b c
$cmin :: forall a b c.
(Ord a, Ord b, Ord c) =>
Either3 a b c -> Either3 a b c -> Either3 a b c
max :: Either3 a b c -> Either3 a b c -> Either3 a b c
$cmax :: forall a b c.
(Ord a, Ord b, Ord c) =>
Either3 a b c -> Either3 a b c -> Either3 a b c
>= :: Either3 a b c -> Either3 a b c -> Bool
$c>= :: forall a b c.
(Ord a, Ord b, Ord c) =>
Either3 a b c -> Either3 a b c -> Bool
> :: Either3 a b c -> Either3 a b c -> Bool
$c> :: forall a b c.
(Ord a, Ord b, Ord c) =>
Either3 a b c -> Either3 a b c -> Bool
<= :: Either3 a b c -> Either3 a b c -> Bool
$c<= :: forall a b c.
(Ord a, Ord b, Ord c) =>
Either3 a b c -> Either3 a b c -> Bool
< :: Either3 a b c -> Either3 a b c -> Bool
$c< :: forall a b c.
(Ord a, Ord b, Ord c) =>
Either3 a b c -> Either3 a b c -> Bool
compare :: Either3 a b c -> Either3 a b c -> Ordering
$ccompare :: forall a b c.
(Ord a, Ord b, Ord c) =>
Either3 a b c -> Either3 a b c -> Ordering
Ord, Int -> Either3 a b c -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b c.
(Show a, Show b, Show c) =>
Int -> Either3 a b c -> ShowS
forall a b c. (Show a, Show b, Show c) => [Either3 a b c] -> ShowS
forall a b c. (Show a, Show b, Show c) => Either3 a b c -> String
showList :: [Either3 a b c] -> ShowS
$cshowList :: forall a b c. (Show a, Show b, Show c) => [Either3 a b c] -> ShowS
show :: Either3 a b c -> String
$cshow :: forall a b c. (Show a, Show b, Show c) => Either3 a b c -> String
showsPrec :: Int -> Either3 a b c -> ShowS
$cshowsPrec :: forall a b c.
(Show a, Show b, Show c) =>
Int -> Either3 a b c -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b c x. Rep (Either3 a b c) x -> Either3 a b c
forall a b c x. Either3 a b c -> Rep (Either3 a b c) x
$cto :: forall a b c x. Rep (Either3 a b c) x -> Either3 a b c
$cfrom :: forall a b c x. Either3 a b c -> Rep (Either3 a b c) x
Generic, forall a b. a -> Either3 a b b -> Either3 a b a
forall a b. (a -> b) -> Either3 a b a -> Either3 a b b
forall a b a b. a -> Either3 a b b -> Either3 a b a
forall a b a b. (a -> b) -> Either3 a b a -> Either3 a b b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Either3 a b b -> Either3 a b a
$c<$ :: forall a b a b. a -> Either3 a b b -> Either3 a b a
fmap :: forall a b. (a -> b) -> Either3 a b a -> Either3 a b b
$cfmap :: forall a b a b. (a -> b) -> Either3 a b a -> Either3 a b b
Functor, forall a. Either3 a b a -> Bool
forall m a. Monoid m => (a -> m) -> Either3 a b a -> m
forall a b. (a -> b -> b) -> b -> Either3 a b a -> b
forall a b a. Eq a => a -> Either3 a b a -> Bool
forall a b a. Num a => Either3 a b a -> a
forall a b a. Ord a => Either3 a b a -> a
forall a b m. Monoid m => Either3 a b m -> m
forall a b a. Either3 a b a -> Bool
forall a b a. Either3 a b a -> Int
forall a b a. Either3 a b a -> [a]
forall a b a. (a -> a -> a) -> Either3 a b a -> a
forall a b m a. Monoid m => (a -> m) -> Either3 a b a -> m
forall a b b a. (b -> a -> b) -> b -> Either3 a b a -> b
forall a b a b. (a -> b -> b) -> b -> Either3 a b a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Either3 a b a -> a
$cproduct :: forall a b a. Num a => Either3 a b a -> a
sum :: forall a. Num a => Either3 a b a -> a
$csum :: forall a b a. Num a => Either3 a b a -> a
minimum :: forall a. Ord a => Either3 a b a -> a
$cminimum :: forall a b a. Ord a => Either3 a b a -> a
maximum :: forall a. Ord a => Either3 a b a -> a
$cmaximum :: forall a b a. Ord a => Either3 a b a -> a
elem :: forall a. Eq a => a -> Either3 a b a -> Bool
$celem :: forall a b a. Eq a => a -> Either3 a b a -> Bool
length :: forall a. Either3 a b a -> Int
$clength :: forall a b a. Either3 a b a -> Int
null :: forall a. Either3 a b a -> Bool
$cnull :: forall a b a. Either3 a b a -> Bool
toList :: forall a. Either3 a b a -> [a]
$ctoList :: forall a b a. Either3 a b a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Either3 a b a -> a
$cfoldl1 :: forall a b a. (a -> a -> a) -> Either3 a b a -> a
foldr1 :: forall a. (a -> a -> a) -> Either3 a b a -> a
$cfoldr1 :: forall a b a. (a -> a -> a) -> Either3 a b a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Either3 a b a -> b
$cfoldl' :: forall a b b a. (b -> a -> b) -> b -> Either3 a b a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Either3 a b a -> b
$cfoldl :: forall a b b a. (b -> a -> b) -> b -> Either3 a b a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Either3 a b a -> b
$cfoldr' :: forall a b a b. (a -> b -> b) -> b -> Either3 a b a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Either3 a b a -> b
$cfoldr :: forall a b a b. (a -> b -> b) -> b -> Either3 a b a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Either3 a b a -> m
$cfoldMap' :: forall a b m a. Monoid m => (a -> m) -> Either3 a b a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Either3 a b a -> m
$cfoldMap :: forall a b m a. Monoid m => (a -> m) -> Either3 a b a -> m
fold :: forall m. Monoid m => Either3 a b m -> m
$cfold :: forall a b m. Monoid m => Either3 a b m -> m
Foldable, forall a b. Functor (Either3 a b)
forall a b. Foldable (Either3 a b)
forall a b (m :: * -> *) a.
Monad m =>
Either3 a b (m a) -> m (Either3 a b a)
forall a b (f :: * -> *) a.
Applicative f =>
Either3 a b (f a) -> f (Either3 a b a)
forall a b (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Either3 a b a -> m (Either3 a b b)
forall a b (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Either3 a b a -> f (Either3 a b b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Either3 a b a -> f (Either3 a b b)
sequence :: forall (m :: * -> *) a.
Monad m =>
Either3 a b (m a) -> m (Either3 a b a)
$csequence :: forall a b (m :: * -> *) a.
Monad m =>
Either3 a b (m a) -> m (Either3 a b a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Either3 a b a -> m (Either3 a b b)
$cmapM :: forall a b (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Either3 a b a -> m (Either3 a b b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Either3 a b (f a) -> f (Either3 a b a)
$csequenceA :: forall a b (f :: * -> *) a.
Applicative f =>
Either3 a b (f a) -> f (Either3 a b a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Either3 a b a -> f (Either3 a b b)
$ctraverse :: forall a b (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Either3 a b a -> f (Either3 a b b)
Traversable)

data Either4 a b c d = E4_1 a | E4_2 b | E4_3 c | E4_4 d deriving (Either4 a b c d -> Either4 a b c d -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b c d.
(Eq a, Eq b, Eq c, Eq d) =>
Either4 a b c d -> Either4 a b c d -> Bool
/= :: Either4 a b c d -> Either4 a b c d -> Bool
$c/= :: forall a b c d.
(Eq a, Eq b, Eq c, Eq d) =>
Either4 a b c d -> Either4 a b c d -> Bool
== :: Either4 a b c d -> Either4 a b c d -> Bool
$c== :: forall a b c d.
(Eq a, Eq b, Eq c, Eq d) =>
Either4 a b c d -> Either4 a b c d -> Bool
Eq, Either4 a b c d -> Either4 a b c d -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a} {b} {c} {d}.
(Ord a, Ord b, Ord c, Ord d) =>
Eq (Either4 a b c d)
forall a b c d.
(Ord a, Ord b, Ord c, Ord d) =>
Either4 a b c d -> Either4 a b c d -> Bool
forall a b c d.
(Ord a, Ord b, Ord c, Ord d) =>
Either4 a b c d -> Either4 a b c d -> Ordering
forall a b c d.
(Ord a, Ord b, Ord c, Ord d) =>
Either4 a b c d -> Either4 a b c d -> Either4 a b c d
min :: Either4 a b c d -> Either4 a b c d -> Either4 a b c d
$cmin :: forall a b c d.
(Ord a, Ord b, Ord c, Ord d) =>
Either4 a b c d -> Either4 a b c d -> Either4 a b c d
max :: Either4 a b c d -> Either4 a b c d -> Either4 a b c d
$cmax :: forall a b c d.
(Ord a, Ord b, Ord c, Ord d) =>
Either4 a b c d -> Either4 a b c d -> Either4 a b c d
>= :: Either4 a b c d -> Either4 a b c d -> Bool
$c>= :: forall a b c d.
(Ord a, Ord b, Ord c, Ord d) =>
Either4 a b c d -> Either4 a b c d -> Bool
> :: Either4 a b c d -> Either4 a b c d -> Bool
$c> :: forall a b c d.
(Ord a, Ord b, Ord c, Ord d) =>
Either4 a b c d -> Either4 a b c d -> Bool
<= :: Either4 a b c d -> Either4 a b c d -> Bool
$c<= :: forall a b c d.
(Ord a, Ord b, Ord c, Ord d) =>
Either4 a b c d -> Either4 a b c d -> Bool
< :: Either4 a b c d -> Either4 a b c d -> Bool
$c< :: forall a b c d.
(Ord a, Ord b, Ord c, Ord d) =>
Either4 a b c d -> Either4 a b c d -> Bool
compare :: Either4 a b c d -> Either4 a b c d -> Ordering
$ccompare :: forall a b c d.
(Ord a, Ord b, Ord c, Ord d) =>
Either4 a b c d -> Either4 a b c d -> Ordering
Ord, Int -> Either4 a b c d -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b c d.
(Show a, Show b, Show c, Show d) =>
Int -> Either4 a b c d -> ShowS
forall a b c d.
(Show a, Show b, Show c, Show d) =>
[Either4 a b c d] -> ShowS
forall a b c d.
(Show a, Show b, Show c, Show d) =>
Either4 a b c d -> String
showList :: [Either4 a b c d] -> ShowS
$cshowList :: forall a b c d.
(Show a, Show b, Show c, Show d) =>
[Either4 a b c d] -> ShowS
show :: Either4 a b c d -> String
$cshow :: forall a b c d.
(Show a, Show b, Show c, Show d) =>
Either4 a b c d -> String
showsPrec :: Int -> Either4 a b c d -> ShowS
$cshowsPrec :: forall a b c d.
(Show a, Show b, Show c, Show d) =>
Int -> Either4 a b c d -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b c d x. Rep (Either4 a b c d) x -> Either4 a b c d
forall a b c d x. Either4 a b c d -> Rep (Either4 a b c d) x
$cto :: forall a b c d x. Rep (Either4 a b c d) x -> Either4 a b c d
$cfrom :: forall a b c d x. Either4 a b c d -> Rep (Either4 a b c d) x
Generic, forall a b. a -> Either4 a b c b -> Either4 a b c a
forall a b. (a -> b) -> Either4 a b c a -> Either4 a b c b
forall a b c a b. a -> Either4 a b c b -> Either4 a b c a
forall a b c a b. (a -> b) -> Either4 a b c a -> Either4 a b c b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Either4 a b c b -> Either4 a b c a
$c<$ :: forall a b c a b. a -> Either4 a b c b -> Either4 a b c a
fmap :: forall a b. (a -> b) -> Either4 a b c a -> Either4 a b c b
$cfmap :: forall a b c a b. (a -> b) -> Either4 a b c a -> Either4 a b c b
Functor, forall a. Either4 a b c a -> Bool
forall m a. Monoid m => (a -> m) -> Either4 a b c a -> m
forall a b. (a -> b -> b) -> b -> Either4 a b c a -> b
forall a b c a. Eq a => a -> Either4 a b c a -> Bool
forall a b c a. Num a => Either4 a b c a -> a
forall a b c a. Ord a => Either4 a b c a -> a
forall a b c m. Monoid m => Either4 a b c m -> m
forall a b c a. Either4 a b c a -> Bool
forall a b c a. Either4 a b c a -> Int
forall a b c a. Either4 a b c a -> [a]
forall a b c a. (a -> a -> a) -> Either4 a b c a -> a
forall a b c m a. Monoid m => (a -> m) -> Either4 a b c a -> m
forall a b c b a. (b -> a -> b) -> b -> Either4 a b c a -> b
forall a b c a b. (a -> b -> b) -> b -> Either4 a b c a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Either4 a b c a -> a
$cproduct :: forall a b c a. Num a => Either4 a b c a -> a
sum :: forall a. Num a => Either4 a b c a -> a
$csum :: forall a b c a. Num a => Either4 a b c a -> a
minimum :: forall a. Ord a => Either4 a b c a -> a
$cminimum :: forall a b c a. Ord a => Either4 a b c a -> a
maximum :: forall a. Ord a => Either4 a b c a -> a
$cmaximum :: forall a b c a. Ord a => Either4 a b c a -> a
elem :: forall a. Eq a => a -> Either4 a b c a -> Bool
$celem :: forall a b c a. Eq a => a -> Either4 a b c a -> Bool
length :: forall a. Either4 a b c a -> Int
$clength :: forall a b c a. Either4 a b c a -> Int
null :: forall a. Either4 a b c a -> Bool
$cnull :: forall a b c a. Either4 a b c a -> Bool
toList :: forall a. Either4 a b c a -> [a]
$ctoList :: forall a b c a. Either4 a b c a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Either4 a b c a -> a
$cfoldl1 :: forall a b c a. (a -> a -> a) -> Either4 a b c a -> a
foldr1 :: forall a. (a -> a -> a) -> Either4 a b c a -> a
$cfoldr1 :: forall a b c a. (a -> a -> a) -> Either4 a b c a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Either4 a b c a -> b
$cfoldl' :: forall a b c b a. (b -> a -> b) -> b -> Either4 a b c a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Either4 a b c a -> b
$cfoldl :: forall a b c b a. (b -> a -> b) -> b -> Either4 a b c a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Either4 a b c a -> b
$cfoldr' :: forall a b c a b. (a -> b -> b) -> b -> Either4 a b c a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Either4 a b c a -> b
$cfoldr :: forall a b c a b. (a -> b -> b) -> b -> Either4 a b c a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Either4 a b c a -> m
$cfoldMap' :: forall a b c m a. Monoid m => (a -> m) -> Either4 a b c a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Either4 a b c a -> m
$cfoldMap :: forall a b c m a. Monoid m => (a -> m) -> Either4 a b c a -> m
fold :: forall m. Monoid m => Either4 a b c m -> m
$cfold :: forall a b c m. Monoid m => Either4 a b c m -> m
Foldable, forall a b c. Functor (Either4 a b c)
forall a b c. Foldable (Either4 a b c)
forall a b c (m :: * -> *) a.
Monad m =>
Either4 a b c (m a) -> m (Either4 a b c a)
forall a b c (f :: * -> *) a.
Applicative f =>
Either4 a b c (f a) -> f (Either4 a b c a)
forall a b c (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Either4 a b c a -> m (Either4 a b c b)
forall a b c (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Either4 a b c a -> f (Either4 a b c b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Either4 a b c a -> f (Either4 a b c b)
sequence :: forall (m :: * -> *) a.
Monad m =>
Either4 a b c (m a) -> m (Either4 a b c a)
$csequence :: forall a b c (m :: * -> *) a.
Monad m =>
Either4 a b c (m a) -> m (Either4 a b c a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Either4 a b c a -> m (Either4 a b c b)
$cmapM :: forall a b c (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Either4 a b c a -> m (Either4 a b c b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Either4 a b c (f a) -> f (Either4 a b c a)
$csequenceA :: forall a b c (f :: * -> *) a.
Applicative f =>
Either4 a b c (f a) -> f (Either4 a b c a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Either4 a b c a -> f (Either4 a b c b)
$ctraverse :: forall a b c (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Either4 a b c a -> f (Either4 a b c b)
Traversable)

data Either5 a b c d e = E5_1 a | E5_2 b | E5_3 c | E5_4 d | E5_5 e deriving (Either5 a b c d e -> Either5 a b c d e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b c d e.
(Eq a, Eq b, Eq c, Eq d, Eq e) =>
Either5 a b c d e -> Either5 a b c d e -> Bool
/= :: Either5 a b c d e -> Either5 a b c d e -> Bool
$c/= :: forall a b c d e.
(Eq a, Eq b, Eq c, Eq d, Eq e) =>
Either5 a b c d e -> Either5 a b c d e -> Bool
== :: Either5 a b c d e -> Either5 a b c d e -> Bool
$c== :: forall a b c d e.
(Eq a, Eq b, Eq c, Eq d, Eq e) =>
Either5 a b c d e -> Either5 a b c d e -> Bool
Eq, Either5 a b c d e -> Either5 a b c d e -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a} {b} {c} {d} {e}.
(Ord a, Ord b, Ord c, Ord d, Ord e) =>
Eq (Either5 a b c d e)
forall a b c d e.
(Ord a, Ord b, Ord c, Ord d, Ord e) =>
Either5 a b c d e -> Either5 a b c d e -> Bool
forall a b c d e.
(Ord a, Ord b, Ord c, Ord d, Ord e) =>
Either5 a b c d e -> Either5 a b c d e -> Ordering
forall a b c d e.
(Ord a, Ord b, Ord c, Ord d, Ord e) =>
Either5 a b c d e -> Either5 a b c d e -> Either5 a b c d e
min :: Either5 a b c d e -> Either5 a b c d e -> Either5 a b c d e
$cmin :: forall a b c d e.
(Ord a, Ord b, Ord c, Ord d, Ord e) =>
Either5 a b c d e -> Either5 a b c d e -> Either5 a b c d e
max :: Either5 a b c d e -> Either5 a b c d e -> Either5 a b c d e
$cmax :: forall a b c d e.
(Ord a, Ord b, Ord c, Ord d, Ord e) =>
Either5 a b c d e -> Either5 a b c d e -> Either5 a b c d e
>= :: Either5 a b c d e -> Either5 a b c d e -> Bool
$c>= :: forall a b c d e.
(Ord a, Ord b, Ord c, Ord d, Ord e) =>
Either5 a b c d e -> Either5 a b c d e -> Bool
> :: Either5 a b c d e -> Either5 a b c d e -> Bool
$c> :: forall a b c d e.
(Ord a, Ord b, Ord c, Ord d, Ord e) =>
Either5 a b c d e -> Either5 a b c d e -> Bool
<= :: Either5 a b c d e -> Either5 a b c d e -> Bool
$c<= :: forall a b c d e.
(Ord a, Ord b, Ord c, Ord d, Ord e) =>
Either5 a b c d e -> Either5 a b c d e -> Bool
< :: Either5 a b c d e -> Either5 a b c d e -> Bool
$c< :: forall a b c d e.
(Ord a, Ord b, Ord c, Ord d, Ord e) =>
Either5 a b c d e -> Either5 a b c d e -> Bool
compare :: Either5 a b c d e -> Either5 a b c d e -> Ordering
$ccompare :: forall a b c d e.
(Ord a, Ord b, Ord c, Ord d, Ord e) =>
Either5 a b c d e -> Either5 a b c d e -> Ordering
Ord, Int -> Either5 a b c d e -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b c d e.
(Show a, Show b, Show c, Show d, Show e) =>
Int -> Either5 a b c d e -> ShowS
forall a b c d e.
(Show a, Show b, Show c, Show d, Show e) =>
[Either5 a b c d e] -> ShowS
forall a b c d e.
(Show a, Show b, Show c, Show d, Show e) =>
Either5 a b c d e -> String
showList :: [Either5 a b c d e] -> ShowS
$cshowList :: forall a b c d e.
(Show a, Show b, Show c, Show d, Show e) =>
[Either5 a b c d e] -> ShowS
show :: Either5 a b c d e -> String
$cshow :: forall a b c d e.
(Show a, Show b, Show c, Show d, Show e) =>
Either5 a b c d e -> String
showsPrec :: Int -> Either5 a b c d e -> ShowS
$cshowsPrec :: forall a b c d e.
(Show a, Show b, Show c, Show d, Show e) =>
Int -> Either5 a b c d e -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b c d e x. Rep (Either5 a b c d e) x -> Either5 a b c d e
forall a b c d e x. Either5 a b c d e -> Rep (Either5 a b c d e) x
$cto :: forall a b c d e x. Rep (Either5 a b c d e) x -> Either5 a b c d e
$cfrom :: forall a b c d e x. Either5 a b c d e -> Rep (Either5 a b c d e) x
Generic, forall a b. a -> Either5 a b c d b -> Either5 a b c d a
forall a b. (a -> b) -> Either5 a b c d a -> Either5 a b c d b
forall a b c d a b. a -> Either5 a b c d b -> Either5 a b c d a
forall a b c d a b.
(a -> b) -> Either5 a b c d a -> Either5 a b c d b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Either5 a b c d b -> Either5 a b c d a
$c<$ :: forall a b c d a b. a -> Either5 a b c d b -> Either5 a b c d a
fmap :: forall a b. (a -> b) -> Either5 a b c d a -> Either5 a b c d b
$cfmap :: forall a b c d a b.
(a -> b) -> Either5 a b c d a -> Either5 a b c d b
Functor, forall a. Either5 a b c d a -> Bool
forall m a. Monoid m => (a -> m) -> Either5 a b c d a -> m
forall a b. (a -> b -> b) -> b -> Either5 a b c d a -> b
forall a b c d a. Eq a => a -> Either5 a b c d a -> Bool
forall a b c d a. Num a => Either5 a b c d a -> a
forall a b c d a. Ord a => Either5 a b c d a -> a
forall a b c d m. Monoid m => Either5 a b c d m -> m
forall a b c d a. Either5 a b c d a -> Bool
forall a b c d a. Either5 a b c d a -> Int
forall a b c d a. Either5 a b c d a -> [a]
forall a b c d a. (a -> a -> a) -> Either5 a b c d a -> a
forall a b c d m a. Monoid m => (a -> m) -> Either5 a b c d a -> m
forall a b c d b a. (b -> a -> b) -> b -> Either5 a b c d a -> b
forall a b c d a b. (a -> b -> b) -> b -> Either5 a b c d a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Either5 a b c d a -> a
$cproduct :: forall a b c d a. Num a => Either5 a b c d a -> a
sum :: forall a. Num a => Either5 a b c d a -> a
$csum :: forall a b c d a. Num a => Either5 a b c d a -> a
minimum :: forall a. Ord a => Either5 a b c d a -> a
$cminimum :: forall a b c d a. Ord a => Either5 a b c d a -> a
maximum :: forall a. Ord a => Either5 a b c d a -> a
$cmaximum :: forall a b c d a. Ord a => Either5 a b c d a -> a
elem :: forall a. Eq a => a -> Either5 a b c d a -> Bool
$celem :: forall a b c d a. Eq a => a -> Either5 a b c d a -> Bool
length :: forall a. Either5 a b c d a -> Int
$clength :: forall a b c d a. Either5 a b c d a -> Int
null :: forall a. Either5 a b c d a -> Bool
$cnull :: forall a b c d a. Either5 a b c d a -> Bool
toList :: forall a. Either5 a b c d a -> [a]
$ctoList :: forall a b c d a. Either5 a b c d a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Either5 a b c d a -> a
$cfoldl1 :: forall a b c d a. (a -> a -> a) -> Either5 a b c d a -> a
foldr1 :: forall a. (a -> a -> a) -> Either5 a b c d a -> a
$cfoldr1 :: forall a b c d a. (a -> a -> a) -> Either5 a b c d a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Either5 a b c d a -> b
$cfoldl' :: forall a b c d b a. (b -> a -> b) -> b -> Either5 a b c d a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Either5 a b c d a -> b
$cfoldl :: forall a b c d b a. (b -> a -> b) -> b -> Either5 a b c d a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Either5 a b c d a -> b
$cfoldr' :: forall a b c d a b. (a -> b -> b) -> b -> Either5 a b c d a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Either5 a b c d a -> b
$cfoldr :: forall a b c d a b. (a -> b -> b) -> b -> Either5 a b c d a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Either5 a b c d a -> m
$cfoldMap' :: forall a b c d m a. Monoid m => (a -> m) -> Either5 a b c d a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Either5 a b c d a -> m
$cfoldMap :: forall a b c d m a. Monoid m => (a -> m) -> Either5 a b c d a -> m
fold :: forall m. Monoid m => Either5 a b c d m -> m
$cfold :: forall a b c d m. Monoid m => Either5 a b c d m -> m
Foldable, forall a b c d. Functor (Either5 a b c d)
forall a b c d. Foldable (Either5 a b c d)
forall a b c d (m :: * -> *) a.
Monad m =>
Either5 a b c d (m a) -> m (Either5 a b c d a)
forall a b c d (f :: * -> *) a.
Applicative f =>
Either5 a b c d (f a) -> f (Either5 a b c d a)
forall a b c d (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Either5 a b c d a -> m (Either5 a b c d b)
forall a b c d (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Either5 a b c d a -> f (Either5 a b c d b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Either5 a b c d a -> f (Either5 a b c d b)
sequence :: forall (m :: * -> *) a.
Monad m =>
Either5 a b c d (m a) -> m (Either5 a b c d a)
$csequence :: forall a b c d (m :: * -> *) a.
Monad m =>
Either5 a b c d (m a) -> m (Either5 a b c d a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Either5 a b c d a -> m (Either5 a b c d b)
$cmapM :: forall a b c d (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Either5 a b c d a -> m (Either5 a b c d b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Either5 a b c d (f a) -> f (Either5 a b c d a)
$csequenceA :: forall a b c d (f :: * -> *) a.
Applicative f =>
Either5 a b c d (f a) -> f (Either5 a b c d a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Either5 a b c d a -> f (Either5 a b c d b)
$ctraverse :: forall a b c d (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Either5 a b c d a -> f (Either5 a b c d b)
Traversable)

data Either6 a b c d e f = E6_1 a | E6_2 b | E6_3 c | E6_4 d | E6_5 e | E6_6 f deriving (Either6 a b c d e f -> Either6 a b c d e f -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b c d e f.
(Eq a, Eq b, Eq c, Eq d, Eq e, Eq f) =>
Either6 a b c d e f -> Either6 a b c d e f -> Bool
/= :: Either6 a b c d e f -> Either6 a b c d e f -> Bool
$c/= :: forall a b c d e f.
(Eq a, Eq b, Eq c, Eq d, Eq e, Eq f) =>
Either6 a b c d e f -> Either6 a b c d e f -> Bool
== :: Either6 a b c d e f -> Either6 a b c d e f -> Bool
$c== :: forall a b c d e f.
(Eq a, Eq b, Eq c, Eq d, Eq e, Eq f) =>
Either6 a b c d e f -> Either6 a b c d e f -> Bool
Eq, Either6 a b c d e f -> Either6 a b c d e f -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a} {b} {c} {d} {e} {f}.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f) =>
Eq (Either6 a b c d e f)
forall a b c d e f.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f) =>
Either6 a b c d e f -> Either6 a b c d e f -> Bool
forall a b c d e f.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f) =>
Either6 a b c d e f -> Either6 a b c d e f -> Ordering
forall a b c d e f.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f) =>
Either6 a b c d e f -> Either6 a b c d e f -> Either6 a b c d e f
min :: Either6 a b c d e f -> Either6 a b c d e f -> Either6 a b c d e f
$cmin :: forall a b c d e f.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f) =>
Either6 a b c d e f -> Either6 a b c d e f -> Either6 a b c d e f
max :: Either6 a b c d e f -> Either6 a b c d e f -> Either6 a b c d e f
$cmax :: forall a b c d e f.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f) =>
Either6 a b c d e f -> Either6 a b c d e f -> Either6 a b c d e f
>= :: Either6 a b c d e f -> Either6 a b c d e f -> Bool
$c>= :: forall a b c d e f.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f) =>
Either6 a b c d e f -> Either6 a b c d e f -> Bool
> :: Either6 a b c d e f -> Either6 a b c d e f -> Bool
$c> :: forall a b c d e f.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f) =>
Either6 a b c d e f -> Either6 a b c d e f -> Bool
<= :: Either6 a b c d e f -> Either6 a b c d e f -> Bool
$c<= :: forall a b c d e f.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f) =>
Either6 a b c d e f -> Either6 a b c d e f -> Bool
< :: Either6 a b c d e f -> Either6 a b c d e f -> Bool
$c< :: forall a b c d e f.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f) =>
Either6 a b c d e f -> Either6 a b c d e f -> Bool
compare :: Either6 a b c d e f -> Either6 a b c d e f -> Ordering
$ccompare :: forall a b c d e f.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f) =>
Either6 a b c d e f -> Either6 a b c d e f -> Ordering
Ord, Int -> Either6 a b c d e f -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b c d e f.
(Show a, Show b, Show c, Show d, Show e, Show f) =>
Int -> Either6 a b c d e f -> ShowS
forall a b c d e f.
(Show a, Show b, Show c, Show d, Show e, Show f) =>
[Either6 a b c d e f] -> ShowS
forall a b c d e f.
(Show a, Show b, Show c, Show d, Show e, Show f) =>
Either6 a b c d e f -> String
showList :: [Either6 a b c d e f] -> ShowS
$cshowList :: forall a b c d e f.
(Show a, Show b, Show c, Show d, Show e, Show f) =>
[Either6 a b c d e f] -> ShowS
show :: Either6 a b c d e f -> String
$cshow :: forall a b c d e f.
(Show a, Show b, Show c, Show d, Show e, Show f) =>
Either6 a b c d e f -> String
showsPrec :: Int -> Either6 a b c d e f -> ShowS
$cshowsPrec :: forall a b c d e f.
(Show a, Show b, Show c, Show d, Show e, Show f) =>
Int -> Either6 a b c d e f -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b c d e f x.
Rep (Either6 a b c d e f) x -> Either6 a b c d e f
forall a b c d e f x.
Either6 a b c d e f -> Rep (Either6 a b c d e f) x
$cto :: forall a b c d e f x.
Rep (Either6 a b c d e f) x -> Either6 a b c d e f
$cfrom :: forall a b c d e f x.
Either6 a b c d e f -> Rep (Either6 a b c d e f) x
Generic, forall a b. a -> Either6 a b c d e b -> Either6 a b c d e a
forall a b. (a -> b) -> Either6 a b c d e a -> Either6 a b c d e b
forall a b c d e a b.
a -> Either6 a b c d e b -> Either6 a b c d e a
forall a b c d e a b.
(a -> b) -> Either6 a b c d e a -> Either6 a b c d e b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Either6 a b c d e b -> Either6 a b c d e a
$c<$ :: forall a b c d e a b.
a -> Either6 a b c d e b -> Either6 a b c d e a
fmap :: forall a b. (a -> b) -> Either6 a b c d e a -> Either6 a b c d e b
$cfmap :: forall a b c d e a b.
(a -> b) -> Either6 a b c d e a -> Either6 a b c d e b
Functor, forall a. Either6 a b c d e a -> Bool
forall m a. Monoid m => (a -> m) -> Either6 a b c d e a -> m
forall a b. (a -> b -> b) -> b -> Either6 a b c d e a -> b
forall a b c d e a. Eq a => a -> Either6 a b c d e a -> Bool
forall a b c d e a. Num a => Either6 a b c d e a -> a
forall a b c d e a. Ord a => Either6 a b c d e a -> a
forall a b c d e m. Monoid m => Either6 a b c d e m -> m
forall a b c d e a. Either6 a b c d e a -> Bool
forall a b c d e a. Either6 a b c d e a -> Int
forall a b c d e a. Either6 a b c d e a -> [a]
forall a b c d e a. (a -> a -> a) -> Either6 a b c d e a -> a
forall a b c d e m a.
Monoid m =>
(a -> m) -> Either6 a b c d e a -> m
forall a b c d e b a.
(b -> a -> b) -> b -> Either6 a b c d e a -> b
forall a b c d e a b.
(a -> b -> b) -> b -> Either6 a b c d e a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Either6 a b c d e a -> a
$cproduct :: forall a b c d e a. Num a => Either6 a b c d e a -> a
sum :: forall a. Num a => Either6 a b c d e a -> a
$csum :: forall a b c d e a. Num a => Either6 a b c d e a -> a
minimum :: forall a. Ord a => Either6 a b c d e a -> a
$cminimum :: forall a b c d e a. Ord a => Either6 a b c d e a -> a
maximum :: forall a. Ord a => Either6 a b c d e a -> a
$cmaximum :: forall a b c d e a. Ord a => Either6 a b c d e a -> a
elem :: forall a. Eq a => a -> Either6 a b c d e a -> Bool
$celem :: forall a b c d e a. Eq a => a -> Either6 a b c d e a -> Bool
length :: forall a. Either6 a b c d e a -> Int
$clength :: forall a b c d e a. Either6 a b c d e a -> Int
null :: forall a. Either6 a b c d e a -> Bool
$cnull :: forall a b c d e a. Either6 a b c d e a -> Bool
toList :: forall a. Either6 a b c d e a -> [a]
$ctoList :: forall a b c d e a. Either6 a b c d e a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Either6 a b c d e a -> a
$cfoldl1 :: forall a b c d e a. (a -> a -> a) -> Either6 a b c d e a -> a
foldr1 :: forall a. (a -> a -> a) -> Either6 a b c d e a -> a
$cfoldr1 :: forall a b c d e a. (a -> a -> a) -> Either6 a b c d e a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Either6 a b c d e a -> b
$cfoldl' :: forall a b c d e b a.
(b -> a -> b) -> b -> Either6 a b c d e a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Either6 a b c d e a -> b
$cfoldl :: forall a b c d e b a.
(b -> a -> b) -> b -> Either6 a b c d e a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Either6 a b c d e a -> b
$cfoldr' :: forall a b c d e a b.
(a -> b -> b) -> b -> Either6 a b c d e a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Either6 a b c d e a -> b
$cfoldr :: forall a b c d e a b.
(a -> b -> b) -> b -> Either6 a b c d e a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Either6 a b c d e a -> m
$cfoldMap' :: forall a b c d e m a.
Monoid m =>
(a -> m) -> Either6 a b c d e a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Either6 a b c d e a -> m
$cfoldMap :: forall a b c d e m a.
Monoid m =>
(a -> m) -> Either6 a b c d e a -> m
fold :: forall m. Monoid m => Either6 a b c d e m -> m
$cfold :: forall a b c d e m. Monoid m => Either6 a b c d e m -> m
Foldable, forall a b c d e. Functor (Either6 a b c d e)
forall a b c d e. Foldable (Either6 a b c d e)
forall a b c d e (m :: * -> *) a.
Monad m =>
Either6 a b c d e (m a) -> m (Either6 a b c d e a)
forall a b c d e (f :: * -> *) a.
Applicative f =>
Either6 a b c d e (f a) -> f (Either6 a b c d e a)
forall a b c d e (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Either6 a b c d e a -> m (Either6 a b c d e b)
forall a b c d e (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Either6 a b c d e a -> f (Either6 a b c d e b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Either6 a b c d e a -> f (Either6 a b c d e b)
sequence :: forall (m :: * -> *) a.
Monad m =>
Either6 a b c d e (m a) -> m (Either6 a b c d e a)
$csequence :: forall a b c d e (m :: * -> *) a.
Monad m =>
Either6 a b c d e (m a) -> m (Either6 a b c d e a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Either6 a b c d e a -> m (Either6 a b c d e b)
$cmapM :: forall a b c d e (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Either6 a b c d e a -> m (Either6 a b c d e b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Either6 a b c d e (f a) -> f (Either6 a b c d e a)
$csequenceA :: forall a b c d e (f :: * -> *) a.
Applicative f =>
Either6 a b c d e (f a) -> f (Either6 a b c d e a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Either6 a b c d e a -> f (Either6 a b c d e b)
$ctraverse :: forall a b c d e (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Either6 a b c d e a -> f (Either6 a b c d e b)
Traversable)

data Either7 a b c d e f g = E7_1 a | E7_2 b | E7_3 c | E7_4 d | E7_5 e | E7_6 f | E7_7 g deriving (Either7 a b c d e f g -> Either7 a b c d e f g -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b c d e f g.
(Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g) =>
Either7 a b c d e f g -> Either7 a b c d e f g -> Bool
/= :: Either7 a b c d e f g -> Either7 a b c d e f g -> Bool
$c/= :: forall a b c d e f g.
(Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g) =>
Either7 a b c d e f g -> Either7 a b c d e f g -> Bool
== :: Either7 a b c d e f g -> Either7 a b c d e f g -> Bool
$c== :: forall a b c d e f g.
(Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g) =>
Either7 a b c d e f g -> Either7 a b c d e f g -> Bool
Eq, Either7 a b c d e f g -> Either7 a b c d e f g -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a} {b} {c} {d} {e} {f} {g}.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g) =>
Eq (Either7 a b c d e f g)
forall a b c d e f g.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g) =>
Either7 a b c d e f g -> Either7 a b c d e f g -> Bool
forall a b c d e f g.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g) =>
Either7 a b c d e f g -> Either7 a b c d e f g -> Ordering
forall a b c d e f g.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g) =>
Either7 a b c d e f g
-> Either7 a b c d e f g -> Either7 a b c d e f g
min :: Either7 a b c d e f g
-> Either7 a b c d e f g -> Either7 a b c d e f g
$cmin :: forall a b c d e f g.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g) =>
Either7 a b c d e f g
-> Either7 a b c d e f g -> Either7 a b c d e f g
max :: Either7 a b c d e f g
-> Either7 a b c d e f g -> Either7 a b c d e f g
$cmax :: forall a b c d e f g.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g) =>
Either7 a b c d e f g
-> Either7 a b c d e f g -> Either7 a b c d e f g
>= :: Either7 a b c d e f g -> Either7 a b c d e f g -> Bool
$c>= :: forall a b c d e f g.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g) =>
Either7 a b c d e f g -> Either7 a b c d e f g -> Bool
> :: Either7 a b c d e f g -> Either7 a b c d e f g -> Bool
$c> :: forall a b c d e f g.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g) =>
Either7 a b c d e f g -> Either7 a b c d e f g -> Bool
<= :: Either7 a b c d e f g -> Either7 a b c d e f g -> Bool
$c<= :: forall a b c d e f g.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g) =>
Either7 a b c d e f g -> Either7 a b c d e f g -> Bool
< :: Either7 a b c d e f g -> Either7 a b c d e f g -> Bool
$c< :: forall a b c d e f g.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g) =>
Either7 a b c d e f g -> Either7 a b c d e f g -> Bool
compare :: Either7 a b c d e f g -> Either7 a b c d e f g -> Ordering
$ccompare :: forall a b c d e f g.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g) =>
Either7 a b c d e f g -> Either7 a b c d e f g -> Ordering
Ord, Int -> Either7 a b c d e f g -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b c d e f g.
(Show a, Show b, Show c, Show d, Show e, Show f, Show g) =>
Int -> Either7 a b c d e f g -> ShowS
forall a b c d e f g.
(Show a, Show b, Show c, Show d, Show e, Show f, Show g) =>
[Either7 a b c d e f g] -> ShowS
forall a b c d e f g.
(Show a, Show b, Show c, Show d, Show e, Show f, Show g) =>
Either7 a b c d e f g -> String
showList :: [Either7 a b c d e f g] -> ShowS
$cshowList :: forall a b c d e f g.
(Show a, Show b, Show c, Show d, Show e, Show f, Show g) =>
[Either7 a b c d e f g] -> ShowS
show :: Either7 a b c d e f g -> String
$cshow :: forall a b c d e f g.
(Show a, Show b, Show c, Show d, Show e, Show f, Show g) =>
Either7 a b c d e f g -> String
showsPrec :: Int -> Either7 a b c d e f g -> ShowS
$cshowsPrec :: forall a b c d e f g.
(Show a, Show b, Show c, Show d, Show e, Show f, Show g) =>
Int -> Either7 a b c d e f g -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b c d e f g x.
Rep (Either7 a b c d e f g) x -> Either7 a b c d e f g
forall a b c d e f g x.
Either7 a b c d e f g -> Rep (Either7 a b c d e f g) x
$cto :: forall a b c d e f g x.
Rep (Either7 a b c d e f g) x -> Either7 a b c d e f g
$cfrom :: forall a b c d e f g x.
Either7 a b c d e f g -> Rep (Either7 a b c d e f g) x
Generic, forall a b. a -> Either7 a b c d e f b -> Either7 a b c d e f a
forall a b.
(a -> b) -> Either7 a b c d e f a -> Either7 a b c d e f b
forall a b c d e f a b.
a -> Either7 a b c d e f b -> Either7 a b c d e f a
forall a b c d e f a b.
(a -> b) -> Either7 a b c d e f a -> Either7 a b c d e f b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Either7 a b c d e f b -> Either7 a b c d e f a
$c<$ :: forall a b c d e f a b.
a -> Either7 a b c d e f b -> Either7 a b c d e f a
fmap :: forall a b.
(a -> b) -> Either7 a b c d e f a -> Either7 a b c d e f b
$cfmap :: forall a b c d e f a b.
(a -> b) -> Either7 a b c d e f a -> Either7 a b c d e f b
Functor, forall a. Either7 a b c d e f a -> Bool
forall m a. Monoid m => (a -> m) -> Either7 a b c d e f a -> m
forall a b. (a -> b -> b) -> b -> Either7 a b c d e f a -> b
forall a b c d e f a. Eq a => a -> Either7 a b c d e f a -> Bool
forall a b c d e f a. Num a => Either7 a b c d e f a -> a
forall a b c d e f a. Ord a => Either7 a b c d e f a -> a
forall a b c d e f m. Monoid m => Either7 a b c d e f m -> m
forall a b c d e f a. Either7 a b c d e f a -> Bool
forall a b c d e f a. Either7 a b c d e f a -> Int
forall a b c d e f a. Either7 a b c d e f a -> [a]
forall a b c d e f a. (a -> a -> a) -> Either7 a b c d e f a -> a
forall a b c d e f m a.
Monoid m =>
(a -> m) -> Either7 a b c d e f a -> m
forall a b c d e f b a.
(b -> a -> b) -> b -> Either7 a b c d e f a -> b
forall a b c d e f a b.
(a -> b -> b) -> b -> Either7 a b c d e f a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Either7 a b c d e f a -> a
$cproduct :: forall a b c d e f a. Num a => Either7 a b c d e f a -> a
sum :: forall a. Num a => Either7 a b c d e f a -> a
$csum :: forall a b c d e f a. Num a => Either7 a b c d e f a -> a
minimum :: forall a. Ord a => Either7 a b c d e f a -> a
$cminimum :: forall a b c d e f a. Ord a => Either7 a b c d e f a -> a
maximum :: forall a. Ord a => Either7 a b c d e f a -> a
$cmaximum :: forall a b c d e f a. Ord a => Either7 a b c d e f a -> a
elem :: forall a. Eq a => a -> Either7 a b c d e f a -> Bool
$celem :: forall a b c d e f a. Eq a => a -> Either7 a b c d e f a -> Bool
length :: forall a. Either7 a b c d e f a -> Int
$clength :: forall a b c d e f a. Either7 a b c d e f a -> Int
null :: forall a. Either7 a b c d e f a -> Bool
$cnull :: forall a b c d e f a. Either7 a b c d e f a -> Bool
toList :: forall a. Either7 a b c d e f a -> [a]
$ctoList :: forall a b c d e f a. Either7 a b c d e f a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Either7 a b c d e f a -> a
$cfoldl1 :: forall a b c d e f a. (a -> a -> a) -> Either7 a b c d e f a -> a
foldr1 :: forall a. (a -> a -> a) -> Either7 a b c d e f a -> a
$cfoldr1 :: forall a b c d e f a. (a -> a -> a) -> Either7 a b c d e f a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Either7 a b c d e f a -> b
$cfoldl' :: forall a b c d e f b a.
(b -> a -> b) -> b -> Either7 a b c d e f a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Either7 a b c d e f a -> b
$cfoldl :: forall a b c d e f b a.
(b -> a -> b) -> b -> Either7 a b c d e f a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Either7 a b c d e f a -> b
$cfoldr' :: forall a b c d e f a b.
(a -> b -> b) -> b -> Either7 a b c d e f a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Either7 a b c d e f a -> b
$cfoldr :: forall a b c d e f a b.
(a -> b -> b) -> b -> Either7 a b c d e f a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Either7 a b c d e f a -> m
$cfoldMap' :: forall a b c d e f m a.
Monoid m =>
(a -> m) -> Either7 a b c d e f a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Either7 a b c d e f a -> m
$cfoldMap :: forall a b c d e f m a.
Monoid m =>
(a -> m) -> Either7 a b c d e f a -> m
fold :: forall m. Monoid m => Either7 a b c d e f m -> m
$cfold :: forall a b c d e f m. Monoid m => Either7 a b c d e f m -> m
Foldable, forall a b c d e f. Functor (Either7 a b c d e f)
forall a b c d e f. Foldable (Either7 a b c d e f)
forall a b c d e f (m :: * -> *) a.
Monad m =>
Either7 a b c d e f (m a) -> m (Either7 a b c d e f a)
forall a b c d e f (f :: * -> *) a.
Applicative f =>
Either7 a b c d e f (f a) -> f (Either7 a b c d e f a)
forall a b c d e f (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Either7 a b c d e f a -> m (Either7 a b c d e f b)
forall a b c d e f (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Either7 a b c d e f a -> f (Either7 a b c d e f b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Either7 a b c d e f a -> f (Either7 a b c d e f b)
sequence :: forall (m :: * -> *) a.
Monad m =>
Either7 a b c d e f (m a) -> m (Either7 a b c d e f a)
$csequence :: forall a b c d e f (m :: * -> *) a.
Monad m =>
Either7 a b c d e f (m a) -> m (Either7 a b c d e f a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Either7 a b c d e f a -> m (Either7 a b c d e f b)
$cmapM :: forall a b c d e f (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Either7 a b c d e f a -> m (Either7 a b c d e f b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Either7 a b c d e f (f a) -> f (Either7 a b c d e f a)
$csequenceA :: forall a b c d e f (f :: * -> *) a.
Applicative f =>
Either7 a b c d e f (f a) -> f (Either7 a b c d e f a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Either7 a b c d e f a -> f (Either7 a b c d e f b)
$ctraverse :: forall a b c d e f (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Either7 a b c d e f a -> f (Either7 a b c d e f b)
Traversable)

data Either8 a b c d e f g h = E8_1 a | E8_2 b | E8_3 c | E8_4 d | E8_5 e | E8_6 f | E8_7 g | E8_8 h deriving (Either8 a b c d e f g h -> Either8 a b c d e f g h -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b c d e f g h.
(Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h) =>
Either8 a b c d e f g h -> Either8 a b c d e f g h -> Bool
/= :: Either8 a b c d e f g h -> Either8 a b c d e f g h -> Bool
$c/= :: forall a b c d e f g h.
(Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h) =>
Either8 a b c d e f g h -> Either8 a b c d e f g h -> Bool
== :: Either8 a b c d e f g h -> Either8 a b c d e f g h -> Bool
$c== :: forall a b c d e f g h.
(Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h) =>
Either8 a b c d e f g h -> Either8 a b c d e f g h -> Bool
Eq, Either8 a b c d e f g h -> Either8 a b c d e f g h -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a} {b} {c} {d} {e} {f} {g} {h}.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g, Ord h) =>
Eq (Either8 a b c d e f g h)
forall a b c d e f g h.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g, Ord h) =>
Either8 a b c d e f g h -> Either8 a b c d e f g h -> Bool
forall a b c d e f g h.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g, Ord h) =>
Either8 a b c d e f g h -> Either8 a b c d e f g h -> Ordering
forall a b c d e f g h.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g, Ord h) =>
Either8 a b c d e f g h
-> Either8 a b c d e f g h -> Either8 a b c d e f g h
min :: Either8 a b c d e f g h
-> Either8 a b c d e f g h -> Either8 a b c d e f g h
$cmin :: forall a b c d e f g h.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g, Ord h) =>
Either8 a b c d e f g h
-> Either8 a b c d e f g h -> Either8 a b c d e f g h
max :: Either8 a b c d e f g h
-> Either8 a b c d e f g h -> Either8 a b c d e f g h
$cmax :: forall a b c d e f g h.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g, Ord h) =>
Either8 a b c d e f g h
-> Either8 a b c d e f g h -> Either8 a b c d e f g h
>= :: Either8 a b c d e f g h -> Either8 a b c d e f g h -> Bool
$c>= :: forall a b c d e f g h.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g, Ord h) =>
Either8 a b c d e f g h -> Either8 a b c d e f g h -> Bool
> :: Either8 a b c d e f g h -> Either8 a b c d e f g h -> Bool
$c> :: forall a b c d e f g h.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g, Ord h) =>
Either8 a b c d e f g h -> Either8 a b c d e f g h -> Bool
<= :: Either8 a b c d e f g h -> Either8 a b c d e f g h -> Bool
$c<= :: forall a b c d e f g h.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g, Ord h) =>
Either8 a b c d e f g h -> Either8 a b c d e f g h -> Bool
< :: Either8 a b c d e f g h -> Either8 a b c d e f g h -> Bool
$c< :: forall a b c d e f g h.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g, Ord h) =>
Either8 a b c d e f g h -> Either8 a b c d e f g h -> Bool
compare :: Either8 a b c d e f g h -> Either8 a b c d e f g h -> Ordering
$ccompare :: forall a b c d e f g h.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g, Ord h) =>
Either8 a b c d e f g h -> Either8 a b c d e f g h -> Ordering
Ord, Int -> Either8 a b c d e f g h -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b c d e f g h.
(Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h) =>
Int -> Either8 a b c d e f g h -> ShowS
forall a b c d e f g h.
(Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h) =>
[Either8 a b c d e f g h] -> ShowS
forall a b c d e f g h.
(Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h) =>
Either8 a b c d e f g h -> String
showList :: [Either8 a b c d e f g h] -> ShowS
$cshowList :: forall a b c d e f g h.
(Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h) =>
[Either8 a b c d e f g h] -> ShowS
show :: Either8 a b c d e f g h -> String
$cshow :: forall a b c d e f g h.
(Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h) =>
Either8 a b c d e f g h -> String
showsPrec :: Int -> Either8 a b c d e f g h -> ShowS
$cshowsPrec :: forall a b c d e f g h.
(Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h) =>
Int -> Either8 a b c d e f g h -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b c d e f g h x.
Rep (Either8 a b c d e f g h) x -> Either8 a b c d e f g h
forall a b c d e f g h x.
Either8 a b c d e f g h -> Rep (Either8 a b c d e f g h) x
$cto :: forall a b c d e f g h x.
Rep (Either8 a b c d e f g h) x -> Either8 a b c d e f g h
$cfrom :: forall a b c d e f g h x.
Either8 a b c d e f g h -> Rep (Either8 a b c d e f g h) x
Generic, forall a b. a -> Either8 a b c d e f g b -> Either8 a b c d e f g a
forall a b.
(a -> b) -> Either8 a b c d e f g a -> Either8 a b c d e f g b
forall a b c d e f g a b.
a -> Either8 a b c d e f g b -> Either8 a b c d e f g a
forall a b c d e f g a b.
(a -> b) -> Either8 a b c d e f g a -> Either8 a b c d e f g b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Either8 a b c d e f g b -> Either8 a b c d e f g a
$c<$ :: forall a b c d e f g a b.
a -> Either8 a b c d e f g b -> Either8 a b c d e f g a
fmap :: forall a b.
(a -> b) -> Either8 a b c d e f g a -> Either8 a b c d e f g b
$cfmap :: forall a b c d e f g a b.
(a -> b) -> Either8 a b c d e f g a -> Either8 a b c d e f g b
Functor, forall a. Either8 a b c d e f g a -> Bool
forall m a. Monoid m => (a -> m) -> Either8 a b c d e f g a -> m
forall a b. (a -> b -> b) -> b -> Either8 a b c d e f g a -> b
forall a b c d e f g a.
Eq a =>
a -> Either8 a b c d e f g a -> Bool
forall a b c d e f g a. Num a => Either8 a b c d e f g a -> a
forall a b c d e f g a. Ord a => Either8 a b c d e f g a -> a
forall a b c d e f g m. Monoid m => Either8 a b c d e f g m -> m
forall a b c d e f g a. Either8 a b c d e f g a -> Bool
forall a b c d e f g a. Either8 a b c d e f g a -> Int
forall a b c d e f g a. Either8 a b c d e f g a -> [a]
forall a b c d e f g a.
(a -> a -> a) -> Either8 a b c d e f g a -> a
forall a b c d e f g m a.
Monoid m =>
(a -> m) -> Either8 a b c d e f g a -> m
forall a b c d e f g b a.
(b -> a -> b) -> b -> Either8 a b c d e f g a -> b
forall a b c d e f g a b.
(a -> b -> b) -> b -> Either8 a b c d e f g a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Either8 a b c d e f g a -> a
$cproduct :: forall a b c d e f g a. Num a => Either8 a b c d e f g a -> a
sum :: forall a. Num a => Either8 a b c d e f g a -> a
$csum :: forall a b c d e f g a. Num a => Either8 a b c d e f g a -> a
minimum :: forall a. Ord a => Either8 a b c d e f g a -> a
$cminimum :: forall a b c d e f g a. Ord a => Either8 a b c d e f g a -> a
maximum :: forall a. Ord a => Either8 a b c d e f g a -> a
$cmaximum :: forall a b c d e f g a. Ord a => Either8 a b c d e f g a -> a
elem :: forall a. Eq a => a -> Either8 a b c d e f g a -> Bool
$celem :: forall a b c d e f g a.
Eq a =>
a -> Either8 a b c d e f g a -> Bool
length :: forall a. Either8 a b c d e f g a -> Int
$clength :: forall a b c d e f g a. Either8 a b c d e f g a -> Int
null :: forall a. Either8 a b c d e f g a -> Bool
$cnull :: forall a b c d e f g a. Either8 a b c d e f g a -> Bool
toList :: forall a. Either8 a b c d e f g a -> [a]
$ctoList :: forall a b c d e f g a. Either8 a b c d e f g a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Either8 a b c d e f g a -> a
$cfoldl1 :: forall a b c d e f g a.
(a -> a -> a) -> Either8 a b c d e f g a -> a
foldr1 :: forall a. (a -> a -> a) -> Either8 a b c d e f g a -> a
$cfoldr1 :: forall a b c d e f g a.
(a -> a -> a) -> Either8 a b c d e f g a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Either8 a b c d e f g a -> b
$cfoldl' :: forall a b c d e f g b a.
(b -> a -> b) -> b -> Either8 a b c d e f g a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Either8 a b c d e f g a -> b
$cfoldl :: forall a b c d e f g b a.
(b -> a -> b) -> b -> Either8 a b c d e f g a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Either8 a b c d e f g a -> b
$cfoldr' :: forall a b c d e f g a b.
(a -> b -> b) -> b -> Either8 a b c d e f g a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Either8 a b c d e f g a -> b
$cfoldr :: forall a b c d e f g a b.
(a -> b -> b) -> b -> Either8 a b c d e f g a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Either8 a b c d e f g a -> m
$cfoldMap' :: forall a b c d e f g m a.
Monoid m =>
(a -> m) -> Either8 a b c d e f g a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Either8 a b c d e f g a -> m
$cfoldMap :: forall a b c d e f g m a.
Monoid m =>
(a -> m) -> Either8 a b c d e f g a -> m
fold :: forall m. Monoid m => Either8 a b c d e f g m -> m
$cfold :: forall a b c d e f g m. Monoid m => Either8 a b c d e f g m -> m
Foldable, forall a b c d e f g. Functor (Either8 a b c d e f g)
forall a b c d e f g. Foldable (Either8 a b c d e f g)
forall a b c d e f g (m :: * -> *) a.
Monad m =>
Either8 a b c d e f g (m a) -> m (Either8 a b c d e f g a)
forall a b c d e f g (f :: * -> *) a.
Applicative f =>
Either8 a b c d e f g (f a) -> f (Either8 a b c d e f g a)
forall a b c d e f g (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> Either8 a b c d e f g a -> m (Either8 a b c d e f g b)
forall a b c d e f g (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> Either8 a b c d e f g a -> f (Either8 a b c d e f g b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> Either8 a b c d e f g a -> f (Either8 a b c d e f g b)
sequence :: forall (m :: * -> *) a.
Monad m =>
Either8 a b c d e f g (m a) -> m (Either8 a b c d e f g a)
$csequence :: forall a b c d e f g (m :: * -> *) a.
Monad m =>
Either8 a b c d e f g (m a) -> m (Either8 a b c d e f g a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> Either8 a b c d e f g a -> m (Either8 a b c d e f g b)
$cmapM :: forall a b c d e f g (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> Either8 a b c d e f g a -> m (Either8 a b c d e f g b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Either8 a b c d e f g (f a) -> f (Either8 a b c d e f g a)
$csequenceA :: forall a b c d e f g (f :: * -> *) a.
Applicative f =>
Either8 a b c d e f g (f a) -> f (Either8 a b c d e f g a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> Either8 a b c d e f g a -> f (Either8 a b c d e f g b)
$ctraverse :: forall a b c d e f g (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> Either8 a b c d e f g a -> f (Either8 a b c d e f g b)
Traversable)

data Either9 a b c d e f g h i = E9_1 a | E9_2 b | E9_3 c | E9_4 d | E9_5 e | E9_6 f | E9_7 g | E9_8 h | E9_9 i deriving (Either9 a b c d e f g h i -> Either9 a b c d e f g h i -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b c d e f g h i.
(Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h, Eq i) =>
Either9 a b c d e f g h i -> Either9 a b c d e f g h i -> Bool
/= :: Either9 a b c d e f g h i -> Either9 a b c d e f g h i -> Bool
$c/= :: forall a b c d e f g h i.
(Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h, Eq i) =>
Either9 a b c d e f g h i -> Either9 a b c d e f g h i -> Bool
== :: Either9 a b c d e f g h i -> Either9 a b c d e f g h i -> Bool
$c== :: forall a b c d e f g h i.
(Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h, Eq i) =>
Either9 a b c d e f g h i -> Either9 a b c d e f g h i -> Bool
Eq, Either9 a b c d e f g h i -> Either9 a b c d e f g h i -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a} {b} {c} {d} {e} {f} {g} {h} {i}.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g, Ord h, Ord i) =>
Eq (Either9 a b c d e f g h i)
forall a b c d e f g h i.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g, Ord h, Ord i) =>
Either9 a b c d e f g h i -> Either9 a b c d e f g h i -> Bool
forall a b c d e f g h i.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g, Ord h, Ord i) =>
Either9 a b c d e f g h i -> Either9 a b c d e f g h i -> Ordering
forall a b c d e f g h i.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g, Ord h, Ord i) =>
Either9 a b c d e f g h i
-> Either9 a b c d e f g h i -> Either9 a b c d e f g h i
min :: Either9 a b c d e f g h i
-> Either9 a b c d e f g h i -> Either9 a b c d e f g h i
$cmin :: forall a b c d e f g h i.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g, Ord h, Ord i) =>
Either9 a b c d e f g h i
-> Either9 a b c d e f g h i -> Either9 a b c d e f g h i
max :: Either9 a b c d e f g h i
-> Either9 a b c d e f g h i -> Either9 a b c d e f g h i
$cmax :: forall a b c d e f g h i.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g, Ord h, Ord i) =>
Either9 a b c d e f g h i
-> Either9 a b c d e f g h i -> Either9 a b c d e f g h i
>= :: Either9 a b c d e f g h i -> Either9 a b c d e f g h i -> Bool
$c>= :: forall a b c d e f g h i.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g, Ord h, Ord i) =>
Either9 a b c d e f g h i -> Either9 a b c d e f g h i -> Bool
> :: Either9 a b c d e f g h i -> Either9 a b c d e f g h i -> Bool
$c> :: forall a b c d e f g h i.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g, Ord h, Ord i) =>
Either9 a b c d e f g h i -> Either9 a b c d e f g h i -> Bool
<= :: Either9 a b c d e f g h i -> Either9 a b c d e f g h i -> Bool
$c<= :: forall a b c d e f g h i.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g, Ord h, Ord i) =>
Either9 a b c d e f g h i -> Either9 a b c d e f g h i -> Bool
< :: Either9 a b c d e f g h i -> Either9 a b c d e f g h i -> Bool
$c< :: forall a b c d e f g h i.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g, Ord h, Ord i) =>
Either9 a b c d e f g h i -> Either9 a b c d e f g h i -> Bool
compare :: Either9 a b c d e f g h i -> Either9 a b c d e f g h i -> Ordering
$ccompare :: forall a b c d e f g h i.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g, Ord h, Ord i) =>
Either9 a b c d e f g h i -> Either9 a b c d e f g h i -> Ordering
Ord, Int -> Either9 a b c d e f g h i -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b c d e f g h i.
(Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h,
 Show i) =>
Int -> Either9 a b c d e f g h i -> ShowS
forall a b c d e f g h i.
(Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h,
 Show i) =>
[Either9 a b c d e f g h i] -> ShowS
forall a b c d e f g h i.
(Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h,
 Show i) =>
Either9 a b c d e f g h i -> String
showList :: [Either9 a b c d e f g h i] -> ShowS
$cshowList :: forall a b c d e f g h i.
(Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h,
 Show i) =>
[Either9 a b c d e f g h i] -> ShowS
show :: Either9 a b c d e f g h i -> String
$cshow :: forall a b c d e f g h i.
(Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h,
 Show i) =>
Either9 a b c d e f g h i -> String
showsPrec :: Int -> Either9 a b c d e f g h i -> ShowS
$cshowsPrec :: forall a b c d e f g h i.
(Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h,
 Show i) =>
Int -> Either9 a b c d e f g h i -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b c d e f g h i x.
Rep (Either9 a b c d e f g h i) x -> Either9 a b c d e f g h i
forall a b c d e f g h i x.
Either9 a b c d e f g h i -> Rep (Either9 a b c d e f g h i) x
$cto :: forall a b c d e f g h i x.
Rep (Either9 a b c d e f g h i) x -> Either9 a b c d e f g h i
$cfrom :: forall a b c d e f g h i x.
Either9 a b c d e f g h i -> Rep (Either9 a b c d e f g h i) x
Generic, forall a b.
a -> Either9 a b c d e f g h b -> Either9 a b c d e f g h a
forall a b.
(a -> b) -> Either9 a b c d e f g h a -> Either9 a b c d e f g h b
forall a b c d e f g h a b.
a -> Either9 a b c d e f g h b -> Either9 a b c d e f g h a
forall a b c d e f g h a b.
(a -> b) -> Either9 a b c d e f g h a -> Either9 a b c d e f g h b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b.
a -> Either9 a b c d e f g h b -> Either9 a b c d e f g h a
$c<$ :: forall a b c d e f g h a b.
a -> Either9 a b c d e f g h b -> Either9 a b c d e f g h a
fmap :: forall a b.
(a -> b) -> Either9 a b c d e f g h a -> Either9 a b c d e f g h b
$cfmap :: forall a b c d e f g h a b.
(a -> b) -> Either9 a b c d e f g h a -> Either9 a b c d e f g h b
Functor, forall a. Either9 a b c d e f g h a -> Bool
forall m a. Monoid m => (a -> m) -> Either9 a b c d e f g h a -> m
forall a b. (a -> b -> b) -> b -> Either9 a b c d e f g h a -> b
forall a b c d e f g h a.
Eq a =>
a -> Either9 a b c d e f g h a -> Bool
forall a b c d e f g h a. Num a => Either9 a b c d e f g h a -> a
forall a b c d e f g h a. Ord a => Either9 a b c d e f g h a -> a
forall a b c d e f g h m.
Monoid m =>
Either9 a b c d e f g h m -> m
forall a b c d e f g h a. Either9 a b c d e f g h a -> Bool
forall a b c d e f g h a. Either9 a b c d e f g h a -> Int
forall a b c d e f g h a. Either9 a b c d e f g h a -> [a]
forall a b c d e f g h a.
(a -> a -> a) -> Either9 a b c d e f g h a -> a
forall a b c d e f g h m a.
Monoid m =>
(a -> m) -> Either9 a b c d e f g h a -> m
forall a b c d e f g h b a.
(b -> a -> b) -> b -> Either9 a b c d e f g h a -> b
forall a b c d e f g h a b.
(a -> b -> b) -> b -> Either9 a b c d e f g h a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Either9 a b c d e f g h a -> a
$cproduct :: forall a b c d e f g h a. Num a => Either9 a b c d e f g h a -> a
sum :: forall a. Num a => Either9 a b c d e f g h a -> a
$csum :: forall a b c d e f g h a. Num a => Either9 a b c d e f g h a -> a
minimum :: forall a. Ord a => Either9 a b c d e f g h a -> a
$cminimum :: forall a b c d e f g h a. Ord a => Either9 a b c d e f g h a -> a
maximum :: forall a. Ord a => Either9 a b c d e f g h a -> a
$cmaximum :: forall a b c d e f g h a. Ord a => Either9 a b c d e f g h a -> a
elem :: forall a. Eq a => a -> Either9 a b c d e f g h a -> Bool
$celem :: forall a b c d e f g h a.
Eq a =>
a -> Either9 a b c d e f g h a -> Bool
length :: forall a. Either9 a b c d e f g h a -> Int
$clength :: forall a b c d e f g h a. Either9 a b c d e f g h a -> Int
null :: forall a. Either9 a b c d e f g h a -> Bool
$cnull :: forall a b c d e f g h a. Either9 a b c d e f g h a -> Bool
toList :: forall a. Either9 a b c d e f g h a -> [a]
$ctoList :: forall a b c d e f g h a. Either9 a b c d e f g h a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Either9 a b c d e f g h a -> a
$cfoldl1 :: forall a b c d e f g h a.
(a -> a -> a) -> Either9 a b c d e f g h a -> a
foldr1 :: forall a. (a -> a -> a) -> Either9 a b c d e f g h a -> a
$cfoldr1 :: forall a b c d e f g h a.
(a -> a -> a) -> Either9 a b c d e f g h a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Either9 a b c d e f g h a -> b
$cfoldl' :: forall a b c d e f g h b a.
(b -> a -> b) -> b -> Either9 a b c d e f g h a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Either9 a b c d e f g h a -> b
$cfoldl :: forall a b c d e f g h b a.
(b -> a -> b) -> b -> Either9 a b c d e f g h a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Either9 a b c d e f g h a -> b
$cfoldr' :: forall a b c d e f g h a b.
(a -> b -> b) -> b -> Either9 a b c d e f g h a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Either9 a b c d e f g h a -> b
$cfoldr :: forall a b c d e f g h a b.
(a -> b -> b) -> b -> Either9 a b c d e f g h a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Either9 a b c d e f g h a -> m
$cfoldMap' :: forall a b c d e f g h m a.
Monoid m =>
(a -> m) -> Either9 a b c d e f g h a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Either9 a b c d e f g h a -> m
$cfoldMap :: forall a b c d e f g h m a.
Monoid m =>
(a -> m) -> Either9 a b c d e f g h a -> m
fold :: forall m. Monoid m => Either9 a b c d e f g h m -> m
$cfold :: forall a b c d e f g h m.
Monoid m =>
Either9 a b c d e f g h m -> m
Foldable, forall a b c d e f g h. Functor (Either9 a b c d e f g h)
forall a b c d e f g h. Foldable (Either9 a b c d e f g h)
forall a b c d e f g h (m :: * -> *) a.
Monad m =>
Either9 a b c d e f g h (m a) -> m (Either9 a b c d e f g h a)
forall a b c d e f g h (f :: * -> *) a.
Applicative f =>
Either9 a b c d e f g h (f a) -> f (Either9 a b c d e f g h a)
forall a b c d e f g h (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> Either9 a b c d e f g h a -> m (Either9 a b c d e f g h b)
forall a b c d e f g h (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> Either9 a b c d e f g h a -> f (Either9 a b c d e f g h b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> Either9 a b c d e f g h a -> f (Either9 a b c d e f g h b)
sequence :: forall (m :: * -> *) a.
Monad m =>
Either9 a b c d e f g h (m a) -> m (Either9 a b c d e f g h a)
$csequence :: forall a b c d e f g h (m :: * -> *) a.
Monad m =>
Either9 a b c d e f g h (m a) -> m (Either9 a b c d e f g h a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> Either9 a b c d e f g h a -> m (Either9 a b c d e f g h b)
$cmapM :: forall a b c d e f g h (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> Either9 a b c d e f g h a -> m (Either9 a b c d e f g h b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Either9 a b c d e f g h (f a) -> f (Either9 a b c d e f g h a)
$csequenceA :: forall a b c d e f g h (f :: * -> *) a.
Applicative f =>
Either9 a b c d e f g h (f a) -> f (Either9 a b c d e f g h a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> Either9 a b c d e f g h a -> f (Either9 a b c d e f g h b)
$ctraverse :: forall a b c d e f g h (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> Either9 a b c d e f g h a -> f (Either9 a b c d e f g h b)
Traversable)

data Either10 a b c d e f g h i j = E10_1 a | E10_2 b | E10_3 c | E10_4 d | E10_5 e | E10_6 f | E10_7 g | E10_8 h | E10_9 i | E10_10 j deriving (Either10 a b c d e f g h i j
-> Either10 a b c d e f g h i j -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b c d e f g h i j.
(Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h, Eq i, Eq j) =>
Either10 a b c d e f g h i j
-> Either10 a b c d e f g h i j -> Bool
/= :: Either10 a b c d e f g h i j
-> Either10 a b c d e f g h i j -> Bool
$c/= :: forall a b c d e f g h i j.
(Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h, Eq i, Eq j) =>
Either10 a b c d e f g h i j
-> Either10 a b c d e f g h i j -> Bool
== :: Either10 a b c d e f g h i j
-> Either10 a b c d e f g h i j -> Bool
$c== :: forall a b c d e f g h i j.
(Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h, Eq i, Eq j) =>
Either10 a b c d e f g h i j
-> Either10 a b c d e f g h i j -> Bool
Eq, Either10 a b c d e f g h i j
-> Either10 a b c d e f g h i j -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a} {b} {c} {d} {e} {f} {g} {h} {i} {j}.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g, Ord h, Ord i,
 Ord j) =>
Eq (Either10 a b c d e f g h i j)
forall a b c d e f g h i j.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g, Ord h, Ord i,
 Ord j) =>
Either10 a b c d e f g h i j
-> Either10 a b c d e f g h i j -> Bool
forall a b c d e f g h i j.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g, Ord h, Ord i,
 Ord j) =>
Either10 a b c d e f g h i j
-> Either10 a b c d e f g h i j -> Ordering
forall a b c d e f g h i j.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g, Ord h, Ord i,
 Ord j) =>
Either10 a b c d e f g h i j
-> Either10 a b c d e f g h i j -> Either10 a b c d e f g h i j
min :: Either10 a b c d e f g h i j
-> Either10 a b c d e f g h i j -> Either10 a b c d e f g h i j
$cmin :: forall a b c d e f g h i j.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g, Ord h, Ord i,
 Ord j) =>
Either10 a b c d e f g h i j
-> Either10 a b c d e f g h i j -> Either10 a b c d e f g h i j
max :: Either10 a b c d e f g h i j
-> Either10 a b c d e f g h i j -> Either10 a b c d e f g h i j
$cmax :: forall a b c d e f g h i j.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g, Ord h, Ord i,
 Ord j) =>
Either10 a b c d e f g h i j
-> Either10 a b c d e f g h i j -> Either10 a b c d e f g h i j
>= :: Either10 a b c d e f g h i j
-> Either10 a b c d e f g h i j -> Bool
$c>= :: forall a b c d e f g h i j.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g, Ord h, Ord i,
 Ord j) =>
Either10 a b c d e f g h i j
-> Either10 a b c d e f g h i j -> Bool
> :: Either10 a b c d e f g h i j
-> Either10 a b c d e f g h i j -> Bool
$c> :: forall a b c d e f g h i j.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g, Ord h, Ord i,
 Ord j) =>
Either10 a b c d e f g h i j
-> Either10 a b c d e f g h i j -> Bool
<= :: Either10 a b c d e f g h i j
-> Either10 a b c d e f g h i j -> Bool
$c<= :: forall a b c d e f g h i j.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g, Ord h, Ord i,
 Ord j) =>
Either10 a b c d e f g h i j
-> Either10 a b c d e f g h i j -> Bool
< :: Either10 a b c d e f g h i j
-> Either10 a b c d e f g h i j -> Bool
$c< :: forall a b c d e f g h i j.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g, Ord h, Ord i,
 Ord j) =>
Either10 a b c d e f g h i j
-> Either10 a b c d e f g h i j -> Bool
compare :: Either10 a b c d e f g h i j
-> Either10 a b c d e f g h i j -> Ordering
$ccompare :: forall a b c d e f g h i j.
(Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g, Ord h, Ord i,
 Ord j) =>
Either10 a b c d e f g h i j
-> Either10 a b c d e f g h i j -> Ordering
Ord, Int -> Either10 a b c d e f g h i j -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b c d e f g h i j.
(Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h,
 Show i, Show j) =>
Int -> Either10 a b c d e f g h i j -> ShowS
forall a b c d e f g h i j.
(Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h,
 Show i, Show j) =>
[Either10 a b c d e f g h i j] -> ShowS
forall a b c d e f g h i j.
(Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h,
 Show i, Show j) =>
Either10 a b c d e f g h i j -> String
showList :: [Either10 a b c d e f g h i j] -> ShowS
$cshowList :: forall a b c d e f g h i j.
(Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h,
 Show i, Show j) =>
[Either10 a b c d e f g h i j] -> ShowS
show :: Either10 a b c d e f g h i j -> String
$cshow :: forall a b c d e f g h i j.
(Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h,
 Show i, Show j) =>
Either10 a b c d e f g h i j -> String
showsPrec :: Int -> Either10 a b c d e f g h i j -> ShowS
$cshowsPrec :: forall a b c d e f g h i j.
(Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h,
 Show i, Show j) =>
Int -> Either10 a b c d e f g h i j -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b c d e f g h i j x.
Rep (Either10 a b c d e f g h i j) x
-> Either10 a b c d e f g h i j
forall a b c d e f g h i j x.
Either10 a b c d e f g h i j
-> Rep (Either10 a b c d e f g h i j) x
$cto :: forall a b c d e f g h i j x.
Rep (Either10 a b c d e f g h i j) x
-> Either10 a b c d e f g h i j
$cfrom :: forall a b c d e f g h i j x.
Either10 a b c d e f g h i j
-> Rep (Either10 a b c d e f g h i j) x
Generic, forall a b.
a -> Either10 a b c d e f g h i b -> Either10 a b c d e f g h i a
forall a b.
(a -> b)
-> Either10 a b c d e f g h i a -> Either10 a b c d e f g h i b
forall a b c d e f g h i a b.
a -> Either10 a b c d e f g h i b -> Either10 a b c d e f g h i a
forall a b c d e f g h i a b.
(a -> b)
-> Either10 a b c d e f g h i a -> Either10 a b c d e f g h i b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b.
a -> Either10 a b c d e f g h i b -> Either10 a b c d e f g h i a
$c<$ :: forall a b c d e f g h i a b.
a -> Either10 a b c d e f g h i b -> Either10 a b c d e f g h i a
fmap :: forall a b.
(a -> b)
-> Either10 a b c d e f g h i a -> Either10 a b c d e f g h i b
$cfmap :: forall a b c d e f g h i a b.
(a -> b)
-> Either10 a b c d e f g h i a -> Either10 a b c d e f g h i b
Functor, forall a. Either10 a b c d e f g h i a -> Bool
forall m a.
Monoid m =>
(a -> m) -> Either10 a b c d e f g h i a -> m
forall a b. (a -> b -> b) -> b -> Either10 a b c d e f g h i a -> b
forall a b c d e f g h i a.
Eq a =>
a -> Either10 a b c d e f g h i a -> Bool
forall a b c d e f g h i a.
Num a =>
Either10 a b c d e f g h i a -> a
forall a b c d e f g h i a.
Ord a =>
Either10 a b c d e f g h i a -> a
forall a b c d e f g h i m.
Monoid m =>
Either10 a b c d e f g h i m -> m
forall a b c d e f g h i a. Either10 a b c d e f g h i a -> Bool
forall a b c d e f g h i a. Either10 a b c d e f g h i a -> Int
forall a b c d e f g h i a. Either10 a b c d e f g h i a -> [a]
forall a b c d e f g h i a.
(a -> a -> a) -> Either10 a b c d e f g h i a -> a
forall a b c d e f g h i m a.
Monoid m =>
(a -> m) -> Either10 a b c d e f g h i a -> m
forall a b c d e f g h i b a.
(b -> a -> b) -> b -> Either10 a b c d e f g h i a -> b
forall a b c d e f g h i a b.
(a -> b -> b) -> b -> Either10 a b c d e f g h i a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Either10 a b c d e f g h i a -> a
$cproduct :: forall a b c d e f g h i a.
Num a =>
Either10 a b c d e f g h i a -> a
sum :: forall a. Num a => Either10 a b c d e f g h i a -> a
$csum :: forall a b c d e f g h i a.
Num a =>
Either10 a b c d e f g h i a -> a
minimum :: forall a. Ord a => Either10 a b c d e f g h i a -> a
$cminimum :: forall a b c d e f g h i a.
Ord a =>
Either10 a b c d e f g h i a -> a
maximum :: forall a. Ord a => Either10 a b c d e f g h i a -> a
$cmaximum :: forall a b c d e f g h i a.
Ord a =>
Either10 a b c d e f g h i a -> a
elem :: forall a. Eq a => a -> Either10 a b c d e f g h i a -> Bool
$celem :: forall a b c d e f g h i a.
Eq a =>
a -> Either10 a b c d e f g h i a -> Bool
length :: forall a. Either10 a b c d e f g h i a -> Int
$clength :: forall a b c d e f g h i a. Either10 a b c d e f g h i a -> Int
null :: forall a. Either10 a b c d e f g h i a -> Bool
$cnull :: forall a b c d e f g h i a. Either10 a b c d e f g h i a -> Bool
toList :: forall a. Either10 a b c d e f g h i a -> [a]
$ctoList :: forall a b c d e f g h i a. Either10 a b c d e f g h i a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Either10 a b c d e f g h i a -> a
$cfoldl1 :: forall a b c d e f g h i a.
(a -> a -> a) -> Either10 a b c d e f g h i a -> a
foldr1 :: forall a. (a -> a -> a) -> Either10 a b c d e f g h i a -> a
$cfoldr1 :: forall a b c d e f g h i a.
(a -> a -> a) -> Either10 a b c d e f g h i a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Either10 a b c d e f g h i a -> b
$cfoldl' :: forall a b c d e f g h i b a.
(b -> a -> b) -> b -> Either10 a b c d e f g h i a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Either10 a b c d e f g h i a -> b
$cfoldl :: forall a b c d e f g h i b a.
(b -> a -> b) -> b -> Either10 a b c d e f g h i a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Either10 a b c d e f g h i a -> b
$cfoldr' :: forall a b c d e f g h i a b.
(a -> b -> b) -> b -> Either10 a b c d e f g h i a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Either10 a b c d e f g h i a -> b
$cfoldr :: forall a b c d e f g h i a b.
(a -> b -> b) -> b -> Either10 a b c d e f g h i a -> b
foldMap' :: forall m a.
Monoid m =>
(a -> m) -> Either10 a b c d e f g h i a -> m
$cfoldMap' :: forall a b c d e f g h i m a.
Monoid m =>
(a -> m) -> Either10 a b c d e f g h i a -> m
foldMap :: forall m a.
Monoid m =>
(a -> m) -> Either10 a b c d e f g h i a -> m
$cfoldMap :: forall a b c d e f g h i m a.
Monoid m =>
(a -> m) -> Either10 a b c d e f g h i a -> m
fold :: forall m. Monoid m => Either10 a b c d e f g h i m -> m
$cfold :: forall a b c d e f g h i m.
Monoid m =>
Either10 a b c d e f g h i m -> m
Foldable, forall a b c d e f g h i. Functor (Either10 a b c d e f g h i)
forall a b c d e f g h i. Foldable (Either10 a b c d e f g h i)
forall a b c d e f g h i (m :: * -> *) a.
Monad m =>
Either10 a b c d e f g h i (m a)
-> m (Either10 a b c d e f g h i a)
forall a b c d e f g h i (f :: * -> *) a.
Applicative f =>
Either10 a b c d e f g h i (f a)
-> f (Either10 a b c d e f g h i a)
forall a b c d e f g h i (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> Either10 a b c d e f g h i a -> m (Either10 a b c d e f g h i b)
forall a b c d e f g h i (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> Either10 a b c d e f g h i a -> f (Either10 a b c d e f g h i b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> Either10 a b c d e f g h i a -> f (Either10 a b c d e f g h i b)
sequence :: forall (m :: * -> *) a.
Monad m =>
Either10 a b c d e f g h i (m a)
-> m (Either10 a b c d e f g h i a)
$csequence :: forall a b c d e f g h i (m :: * -> *) a.
Monad m =>
Either10 a b c d e f g h i (m a)
-> m (Either10 a b c d e f g h i a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> Either10 a b c d e f g h i a -> m (Either10 a b c d e f g h i b)
$cmapM :: forall a b c d e f g h i (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> Either10 a b c d e f g h i a -> m (Either10 a b c d e f g h i b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Either10 a b c d e f g h i (f a)
-> f (Either10 a b c d e f g h i a)
$csequenceA :: forall a b c d e f g h i (f :: * -> *) a.
Applicative f =>
Either10 a b c d e f g h i (f a)
-> f (Either10 a b c d e f g h i a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> Either10 a b c d e f g h i a -> f (Either10 a b c d e f g h i b)
$ctraverse :: forall a b c d e f g h i (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> Either10 a b c d e f g h i a -> f (Either10 a b c d e f g h i b)
Traversable)

instance Applicative (Either3 a b) where
  pure :: forall a. a -> Either3 a b a
pure = forall a b a. a -> Either3 a b a
E3_3
  E3_1 a
a <*> :: forall a b. Either3 a b (a -> b) -> Either3 a b a -> Either3 a b b
<*> Either3 a b a
_ = forall a b c. a -> Either3 a b c
E3_1 a
a
  E3_2 b
a <*> Either3 a b a
_ = forall a b c. b -> Either3 a b c
E3_2 b
a
  E3_3 a -> b
f <*> Either3 a b a
r = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Either3 a b a
r

instance Applicative (Either4 a b c) where
  pure :: forall a. a -> Either4 a b c a
pure = forall a b c a. a -> Either4 a b c a
E4_4
  E4_1 a
a <*> :: forall a b.
Either4 a b c (a -> b) -> Either4 a b c a -> Either4 a b c b
<*> Either4 a b c a
_ = forall a b c d. a -> Either4 a b c d
E4_1 a
a
  E4_2 b
a <*> Either4 a b c a
_ = forall a b c d. b -> Either4 a b c d
E4_2 b
a
  E4_3 c
a <*> Either4 a b c a
_ = forall a b c d. c -> Either4 a b c d
E4_3 c
a
  E4_4 a -> b
f <*> Either4 a b c a
r = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Either4 a b c a
r

instance Applicative (Either5 a b c d) where
  pure :: forall a. a -> Either5 a b c d a
pure = forall a b c d a. a -> Either5 a b c d a
E5_5
  E5_1 a
a <*> :: forall a b.
Either5 a b c d (a -> b) -> Either5 a b c d a -> Either5 a b c d b
<*> Either5 a b c d a
_ = forall a b c d e. a -> Either5 a b c d e
E5_1 a
a
  E5_2 b
a <*> Either5 a b c d a
_ = forall a b c d e. b -> Either5 a b c d e
E5_2 b
a
  E5_3 c
a <*> Either5 a b c d a
_ = forall a b c d e. c -> Either5 a b c d e
E5_3 c
a
  E5_4 d
a <*> Either5 a b c d a
_ = forall a b c d e. d -> Either5 a b c d e
E5_4 d
a
  E5_5 a -> b
f <*> Either5 a b c d a
r = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Either5 a b c d a
r

instance Applicative (Either6 a b c d e) where
  pure :: forall a. a -> Either6 a b c d e a
pure = forall a b c d e a. a -> Either6 a b c d e a
E6_6
  E6_1 a
a <*> :: forall a b.
Either6 a b c d e (a -> b)
-> Either6 a b c d e a -> Either6 a b c d e b
<*> Either6 a b c d e a
_ = forall a b c d e f. a -> Either6 a b c d e f
E6_1 a
a
  E6_2 b
a <*> Either6 a b c d e a
_ = forall a b c d e f. b -> Either6 a b c d e f
E6_2 b
a
  E6_3 c
a <*> Either6 a b c d e a
_ = forall a b c d e f. c -> Either6 a b c d e f
E6_3 c
a
  E6_4 d
a <*> Either6 a b c d e a
_ = forall a b c d e f. d -> Either6 a b c d e f
E6_4 d
a
  E6_5 e
a <*> Either6 a b c d e a
_ = forall a b c d e f. e -> Either6 a b c d e f
E6_5 e
a
  E6_6 a -> b
f <*> Either6 a b c d e a
r = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Either6 a b c d e a
r

instance Applicative (Either7 a b c d e f) where
  pure :: forall a. a -> Either7 a b c d e f a
pure = forall a b c d e f a. a -> Either7 a b c d e f a
E7_7
  E7_1 a
a <*> :: forall a b.
Either7 a b c d e f (a -> b)
-> Either7 a b c d e f a -> Either7 a b c d e f b
<*> Either7 a b c d e f a
_ = forall a b c d e f g. a -> Either7 a b c d e f g
E7_1 a
a
  E7_2 b
a <*> Either7 a b c d e f a
_ = forall a b c d e f g. b -> Either7 a b c d e f g
E7_2 b
a
  E7_3 c
a <*> Either7 a b c d e f a
_ = forall a b c d e f g. c -> Either7 a b c d e f g
E7_3 c
a
  E7_4 d
a <*> Either7 a b c d e f a
_ = forall a b c d e f g. d -> Either7 a b c d e f g
E7_4 d
a
  E7_5 e
a <*> Either7 a b c d e f a
_ = forall a b c d e f g. e -> Either7 a b c d e f g
E7_5 e
a
  E7_6 f
a <*> Either7 a b c d e f a
_ = forall a b c d e f g. f -> Either7 a b c d e f g
E7_6 f
a
  E7_7 a -> b
f <*> Either7 a b c d e f a
r = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Either7 a b c d e f a
r

instance Applicative (Either8 a b c d e f g) where
  pure :: forall a. a -> Either8 a b c d e f g a
pure = forall a b c d e f g a. a -> Either8 a b c d e f g a
E8_8
  E8_1 a
a <*> :: forall a b.
Either8 a b c d e f g (a -> b)
-> Either8 a b c d e f g a -> Either8 a b c d e f g b
<*> Either8 a b c d e f g a
_ = forall a b c d e f g h. a -> Either8 a b c d e f g h
E8_1 a
a
  E8_2 b
a <*> Either8 a b c d e f g a
_ = forall a b c d e f g h. b -> Either8 a b c d e f g h
E8_2 b
a
  E8_3 c
a <*> Either8 a b c d e f g a
_ = forall a b c d e f g h. c -> Either8 a b c d e f g h
E8_3 c
a
  E8_4 d
a <*> Either8 a b c d e f g a
_ = forall a b c d e f g h. d -> Either8 a b c d e f g h
E8_4 d
a
  E8_5 e
a <*> Either8 a b c d e f g a
_ = forall a b c d e f g h. e -> Either8 a b c d e f g h
E8_5 e
a
  E8_6 f
a <*> Either8 a b c d e f g a
_ = forall a b c d e f g h. f -> Either8 a b c d e f g h
E8_6 f
a
  E8_7 g
a <*> Either8 a b c d e f g a
_ = forall a b c d e f g h. g -> Either8 a b c d e f g h
E8_7 g
a
  E8_8 a -> b
f <*> Either8 a b c d e f g a
r = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Either8 a b c d e f g a
r

instance Applicative (Either9 a b c d e f g h) where
  pure :: forall a. a -> Either9 a b c d e f g h a
pure = forall a b c d e f g h a. a -> Either9 a b c d e f g h a
E9_9
  E9_1 a
a <*> :: forall a b.
Either9 a b c d e f g h (a -> b)
-> Either9 a b c d e f g h a -> Either9 a b c d e f g h b
<*> Either9 a b c d e f g h a
_ = forall a b c d e f g h i. a -> Either9 a b c d e f g h i
E9_1 a
a
  E9_2 b
a <*> Either9 a b c d e f g h a
_ = forall a b c d e f g h i. b -> Either9 a b c d e f g h i
E9_2 b
a
  E9_3 c
a <*> Either9 a b c d e f g h a
_ = forall a b c d e f g h i. c -> Either9 a b c d e f g h i
E9_3 c
a
  E9_4 d
a <*> Either9 a b c d e f g h a
_ = forall a b c d e f g h i. d -> Either9 a b c d e f g h i
E9_4 d
a
  E9_5 e
a <*> Either9 a b c d e f g h a
_ = forall a b c d e f g h i. e -> Either9 a b c d e f g h i
E9_5 e
a
  E9_6 f
a <*> Either9 a b c d e f g h a
_ = forall a b c d e f g h i. f -> Either9 a b c d e f g h i
E9_6 f
a
  E9_7 g
a <*> Either9 a b c d e f g h a
_ = forall a b c d e f g h i. g -> Either9 a b c d e f g h i
E9_7 g
a
  E9_8 h
a <*> Either9 a b c d e f g h a
_ = forall a b c d e f g h i. h -> Either9 a b c d e f g h i
E9_8 h
a
  E9_9 a -> b
f <*> Either9 a b c d e f g h a
r = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Either9 a b c d e f g h a
r

instance Applicative (Either10 a b c d e f g h i) where
  pure :: forall a. a -> Either10 a b c d e f g h i a
pure = forall a b c d e f g h i a. a -> Either10 a b c d e f g h i a
E10_10
  E10_1 a
a <*> :: forall a b.
Either10 a b c d e f g h i (a -> b)
-> Either10 a b c d e f g h i a -> Either10 a b c d e f g h i b
<*> Either10 a b c d e f g h i a
_ = forall a b c d e f g h i j. a -> Either10 a b c d e f g h i j
E10_1 a
a
  E10_2 b
a <*> Either10 a b c d e f g h i a
_ = forall a b c d e f g h i j. b -> Either10 a b c d e f g h i j
E10_2 b
a
  E10_3 c
a <*> Either10 a b c d e f g h i a
_ = forall a b c d e f g h i j. c -> Either10 a b c d e f g h i j
E10_3 c
a
  E10_4 d
a <*> Either10 a b c d e f g h i a
_ = forall a b c d e f g h i j. d -> Either10 a b c d e f g h i j
E10_4 d
a
  E10_5 e
a <*> Either10 a b c d e f g h i a
_ = forall a b c d e f g h i j. e -> Either10 a b c d e f g h i j
E10_5 e
a
  E10_6 f
a <*> Either10 a b c d e f g h i a
_ = forall a b c d e f g h i j. f -> Either10 a b c d e f g h i j
E10_6 f
a
  E10_7 g
a <*> Either10 a b c d e f g h i a
_ = forall a b c d e f g h i j. g -> Either10 a b c d e f g h i j
E10_7 g
a
  E10_8 h
a <*> Either10 a b c d e f g h i a
_ = forall a b c d e f g h i j. h -> Either10 a b c d e f g h i j
E10_8 h
a
  E10_9 i
a <*> Either10 a b c d e f g h i a
_ = forall a b c d e f g h i j. i -> Either10 a b c d e f g h i j
E10_9 i
a
  E10_10 a -> b
f <*> Either10 a b c d e f g h i a
r = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Either10 a b c d e f g h i a
r

instance Bifunctor (Either3 a) where
  bimap :: forall a b c d.
(a -> b) -> (c -> d) -> Either3 a a c -> Either3 a b d
bimap a -> b
_ c -> d
_ (E3_1 a
a) = forall a b c. a -> Either3 a b c
E3_1 a
a
  bimap a -> b
f c -> d
_ (E3_2 a
a) = forall a b c. b -> Either3 a b c
E3_2 (a -> b
f a
a)
  bimap a -> b
_ c -> d
g (E3_3 c
a) = forall a b a. a -> Either3 a b a
E3_3 (c -> d
g c
a)

instance Bifunctor (Either4 a b) where
  bimap :: forall a b c d.
(a -> b) -> (c -> d) -> Either4 a b a c -> Either4 a b b d
bimap a -> b
_ c -> d
_ (E4_1 a
a) = forall a b c d. a -> Either4 a b c d
E4_1 a
a
  bimap a -> b
_ c -> d
_ (E4_2 b
a) = forall a b c d. b -> Either4 a b c d
E4_2 b
a
  bimap a -> b
f c -> d
_ (E4_3 a
a) = forall a b c d. c -> Either4 a b c d
E4_3 (a -> b
f a
a)
  bimap a -> b
_ c -> d
g (E4_4 c
a) = forall a b c a. a -> Either4 a b c a
E4_4 (c -> d
g c
a)

instance Bifunctor (Either5 a b c) where
  bimap :: forall a b c d.
(a -> b) -> (c -> d) -> Either5 a b c a c -> Either5 a b c b d
bimap a -> b
_ c -> d
_ (E5_1 a
a) = forall a b c d e. a -> Either5 a b c d e
E5_1 a
a
  bimap a -> b
_ c -> d
_ (E5_2 b
a) = forall a b c d e. b -> Either5 a b c d e
E5_2 b
a
  bimap a -> b
_ c -> d
_ (E5_3 c
a) = forall a b c d e. c -> Either5 a b c d e
E5_3 c
a
  bimap a -> b
f c -> d
_ (E5_4 a
a) = forall a b c d e. d -> Either5 a b c d e
E5_4 (a -> b
f a
a)
  bimap a -> b
_ c -> d
g (E5_5 c
a) = forall a b c d a. a -> Either5 a b c d a
E5_5 (c -> d
g c
a)

instance Bifunctor (Either6 a b c d) where
  bimap :: forall a b c d.
(a -> b) -> (c -> d) -> Either6 a b c d a c -> Either6 a b c d b d
bimap a -> b
_ c -> d
_ (E6_1 a
a) = forall a b c d e f. a -> Either6 a b c d e f
E6_1 a
a
  bimap a -> b
_ c -> d
_ (E6_2 b
a) = forall a b c d e f. b -> Either6 a b c d e f
E6_2 b
a
  bimap a -> b
_ c -> d
_ (E6_3 c
a) = forall a b c d e f. c -> Either6 a b c d e f
E6_3 c
a
  bimap a -> b
_ c -> d
_ (E6_4 d
a) = forall a b c d e f. d -> Either6 a b c d e f
E6_4 d
a
  bimap a -> b
f c -> d
_ (E6_5 a
a) = forall a b c d e f. e -> Either6 a b c d e f
E6_5 (a -> b
f a
a)
  bimap a -> b
_ c -> d
g (E6_6 c
a) = forall a b c d e a. a -> Either6 a b c d e a
E6_6 (c -> d
g c
a)

instance Bifunctor (Either7 a b c d e) where
  bimap :: forall a b c d.
(a -> b)
-> (c -> d) -> Either7 a b c d e a c -> Either7 a b c d e b d
bimap a -> b
_ c -> d
_ (E7_1 a
a) = forall a b c d e f g. a -> Either7 a b c d e f g
E7_1 a
a
  bimap a -> b
_ c -> d
_ (E7_2 b
a) = forall a b c d e f g. b -> Either7 a b c d e f g
E7_2 b
a
  bimap a -> b
_ c -> d
_ (E7_3 c
a) = forall a b c d e f g. c -> Either7 a b c d e f g
E7_3 c
a
  bimap a -> b
_ c -> d
_ (E7_4 d
a) = forall a b c d e f g. d -> Either7 a b c d e f g
E7_4 d
a
  bimap a -> b
_ c -> d
_ (E7_5 e
a) = forall a b c d e f g. e -> Either7 a b c d e f g
E7_5 e
a
  bimap a -> b
f c -> d
_ (E7_6 a
a) = forall a b c d e f g. f -> Either7 a b c d e f g
E7_6 (a -> b
f a
a)
  bimap a -> b
_ c -> d
g (E7_7 c
a) = forall a b c d e f a. a -> Either7 a b c d e f a
E7_7 (c -> d
g c
a)

instance Bifunctor (Either8 a b c d e f) where
  bimap :: forall a b c d.
(a -> b)
-> (c -> d) -> Either8 a b c d e f a c -> Either8 a b c d e f b d
bimap a -> b
_ c -> d
_ (E8_1 a
a) = forall a b c d e f g h. a -> Either8 a b c d e f g h
E8_1 a
a
  bimap a -> b
_ c -> d
_ (E8_2 b
a) = forall a b c d e f g h. b -> Either8 a b c d e f g h
E8_2 b
a
  bimap a -> b
_ c -> d
_ (E8_3 c
a) = forall a b c d e f g h. c -> Either8 a b c d e f g h
E8_3 c
a
  bimap a -> b
_ c -> d
_ (E8_4 d
a) = forall a b c d e f g h. d -> Either8 a b c d e f g h
E8_4 d
a
  bimap a -> b
_ c -> d
_ (E8_5 e
a) = forall a b c d e f g h. e -> Either8 a b c d e f g h
E8_5 e
a
  bimap a -> b
_ c -> d
_ (E8_6 f
a) = forall a b c d e f g h. f -> Either8 a b c d e f g h
E8_6 f
a
  bimap a -> b
f c -> d
_ (E8_7 a
a) = forall a b c d e f g h. g -> Either8 a b c d e f g h
E8_7 (a -> b
f a
a)
  bimap a -> b
_ c -> d
g (E8_8 c
a) = forall a b c d e f g a. a -> Either8 a b c d e f g a
E8_8 (c -> d
g c
a)

instance Bifunctor (Either9 a b c d e f g) where
  bimap :: forall a b c d.
(a -> b)
-> (c -> d)
-> Either9 a b c d e f g a c
-> Either9 a b c d e f g b d
bimap a -> b
_ c -> d
_ (E9_1 a
a) = forall a b c d e f g h i. a -> Either9 a b c d e f g h i
E9_1 a
a
  bimap a -> b
_ c -> d
_ (E9_2 b
a) = forall a b c d e f g h i. b -> Either9 a b c d e f g h i
E9_2 b
a
  bimap a -> b
_ c -> d
_ (E9_3 c
a) = forall a b c d e f g h i. c -> Either9 a b c d e f g h i
E9_3 c
a
  bimap a -> b
_ c -> d
_ (E9_4 d
a) = forall a b c d e f g h i. d -> Either9 a b c d e f g h i
E9_4 d
a
  bimap a -> b
_ c -> d
_ (E9_5 e
a) = forall a b c d e f g h i. e -> Either9 a b c d e f g h i
E9_5 e
a
  bimap a -> b
_ c -> d
_ (E9_6 f
a) = forall a b c d e f g h i. f -> Either9 a b c d e f g h i
E9_6 f
a
  bimap a -> b
_ c -> d
_ (E9_7 g
a) = forall a b c d e f g h i. g -> Either9 a b c d e f g h i
E9_7 g
a
  bimap a -> b
f c -> d
_ (E9_8 a
a) = forall a b c d e f g h i. h -> Either9 a b c d e f g h i
E9_8 (a -> b
f a
a)
  bimap a -> b
_ c -> d
g (E9_9 c
a) = forall a b c d e f g h a. a -> Either9 a b c d e f g h a
E9_9 (c -> d
g c
a)

instance Bifunctor (Either10 a b c d e f g h) where
  bimap :: forall a b c d.
(a -> b)
-> (c -> d)
-> Either10 a b c d e f g h a c
-> Either10 a b c d e f g h b d
bimap a -> b
_ c -> d
_ (E10_1 a
a)  = forall a b c d e f g h i j. a -> Either10 a b c d e f g h i j
E10_1 a
a
  bimap a -> b
_ c -> d
_ (E10_2 b
a)  = forall a b c d e f g h i j. b -> Either10 a b c d e f g h i j
E10_2 b
a
  bimap a -> b
_ c -> d
_ (E10_3 c
a)  = forall a b c d e f g h i j. c -> Either10 a b c d e f g h i j
E10_3 c
a
  bimap a -> b
_ c -> d
_ (E10_4 d
a)  = forall a b c d e f g h i j. d -> Either10 a b c d e f g h i j
E10_4 d
a
  bimap a -> b
_ c -> d
_ (E10_5 e
a)  = forall a b c d e f g h i j. e -> Either10 a b c d e f g h i j
E10_5 e
a
  bimap a -> b
_ c -> d
_ (E10_6 f
a)  = forall a b c d e f g h i j. f -> Either10 a b c d e f g h i j
E10_6 f
a
  bimap a -> b
_ c -> d
_ (E10_7 g
a)  = forall a b c d e f g h i j. g -> Either10 a b c d e f g h i j
E10_7 g
a
  bimap a -> b
_ c -> d
_ (E10_8 h
a)  = forall a b c d e f g h i j. h -> Either10 a b c d e f g h i j
E10_8 h
a
  bimap a -> b
f c -> d
_ (E10_9 a
a)  = forall a b c d e f g h i j. i -> Either10 a b c d e f g h i j
E10_9 (a -> b
f a
a)
  bimap a -> b
_ c -> d
g (E10_10 c
a) = forall a b c d e f g h i a. a -> Either10 a b c d e f g h i a
E10_10 (c -> d
g c
a)

instance Monad (Either3 a b) where
  E3_1 a
a >>= :: forall a b. Either3 a b a -> (a -> Either3 a b b) -> Either3 a b b
>>= a -> Either3 a b b
_ = forall a b c. a -> Either3 a b c
E3_1 a
a
  E3_2 b
a >>= a -> Either3 a b b
_ = forall a b c. b -> Either3 a b c
E3_2 b
a
  E3_3 a
a >>= a -> Either3 a b b
f = a -> Either3 a b b
f a
a

instance Monad (Either4 a b c) where
  E4_1 a
a >>= :: forall a b.
Either4 a b c a -> (a -> Either4 a b c b) -> Either4 a b c b
>>= a -> Either4 a b c b
_ = forall a b c d. a -> Either4 a b c d
E4_1 a
a
  E4_2 b
a >>= a -> Either4 a b c b
_ = forall a b c d. b -> Either4 a b c d
E4_2 b
a
  E4_3 c
a >>= a -> Either4 a b c b
_ = forall a b c d. c -> Either4 a b c d
E4_3 c
a
  E4_4 a
a >>= a -> Either4 a b c b
f = a -> Either4 a b c b
f a
a

instance Monad (Either5 a b c d) where
  E5_1 a
a >>= :: forall a b.
Either5 a b c d a -> (a -> Either5 a b c d b) -> Either5 a b c d b
>>= a -> Either5 a b c d b
_ = forall a b c d e. a -> Either5 a b c d e
E5_1 a
a
  E5_2 b
a >>= a -> Either5 a b c d b
_ = forall a b c d e. b -> Either5 a b c d e
E5_2 b
a
  E5_3 c
a >>= a -> Either5 a b c d b
_ = forall a b c d e. c -> Either5 a b c d e
E5_3 c
a
  E5_4 d
a >>= a -> Either5 a b c d b
_ = forall a b c d e. d -> Either5 a b c d e
E5_4 d
a
  E5_5 a
a >>= a -> Either5 a b c d b
f = a -> Either5 a b c d b
f a
a

instance Monad (Either6 a b c d e) where
  E6_1 a
a >>= :: forall a b.
Either6 a b c d e a
-> (a -> Either6 a b c d e b) -> Either6 a b c d e b
>>= a -> Either6 a b c d e b
_ = forall a b c d e f. a -> Either6 a b c d e f
E6_1 a
a
  E6_2 b
a >>= a -> Either6 a b c d e b
_ = forall a b c d e f. b -> Either6 a b c d e f
E6_2 b
a
  E6_3 c
a >>= a -> Either6 a b c d e b
_ = forall a b c d e f. c -> Either6 a b c d e f
E6_3 c
a
  E6_4 d
a >>= a -> Either6 a b c d e b
_ = forall a b c d e f. d -> Either6 a b c d e f
E6_4 d
a
  E6_5 e
a >>= a -> Either6 a b c d e b
_ = forall a b c d e f. e -> Either6 a b c d e f
E6_5 e
a
  E6_6 a
a >>= a -> Either6 a b c d e b
f = a -> Either6 a b c d e b
f a
a

instance Monad (Either7 a b c d e f) where
  E7_1 a
a >>= :: forall a b.
Either7 a b c d e f a
-> (a -> Either7 a b c d e f b) -> Either7 a b c d e f b
>>= a -> Either7 a b c d e f b
_ = forall a b c d e f g. a -> Either7 a b c d e f g
E7_1 a
a
  E7_2 b
a >>= a -> Either7 a b c d e f b
_ = forall a b c d e f g. b -> Either7 a b c d e f g
E7_2 b
a
  E7_3 c
a >>= a -> Either7 a b c d e f b
_ = forall a b c d e f g. c -> Either7 a b c d e f g
E7_3 c
a
  E7_4 d
a >>= a -> Either7 a b c d e f b
_ = forall a b c d e f g. d -> Either7 a b c d e f g
E7_4 d
a
  E7_5 e
a >>= a -> Either7 a b c d e f b
_ = forall a b c d e f g. e -> Either7 a b c d e f g
E7_5 e
a
  E7_6 f
a >>= a -> Either7 a b c d e f b
_ = forall a b c d e f g. f -> Either7 a b c d e f g
E7_6 f
a
  E7_7 a
a >>= a -> Either7 a b c d e f b
f = a -> Either7 a b c d e f b
f a
a

instance Monad (Either8 a b c d e f g) where
  E8_1 a
a >>= :: forall a b.
Either8 a b c d e f g a
-> (a -> Either8 a b c d e f g b) -> Either8 a b c d e f g b
>>= a -> Either8 a b c d e f g b
_ = forall a b c d e f g h. a -> Either8 a b c d e f g h
E8_1 a
a
  E8_2 b
a >>= a -> Either8 a b c d e f g b
_ = forall a b c d e f g h. b -> Either8 a b c d e f g h
E8_2 b
a
  E8_3 c
a >>= a -> Either8 a b c d e f g b
_ = forall a b c d e f g h. c -> Either8 a b c d e f g h
E8_3 c
a
  E8_4 d
a >>= a -> Either8 a b c d e f g b
_ = forall a b c d e f g h. d -> Either8 a b c d e f g h
E8_4 d
a
  E8_5 e
a >>= a -> Either8 a b c d e f g b
_ = forall a b c d e f g h. e -> Either8 a b c d e f g h
E8_5 e
a
  E8_6 f
a >>= a -> Either8 a b c d e f g b
_ = forall a b c d e f g h. f -> Either8 a b c d e f g h
E8_6 f
a
  E8_7 g
a >>= a -> Either8 a b c d e f g b
_ = forall a b c d e f g h. g -> Either8 a b c d e f g h
E8_7 g
a
  E8_8 a
a >>= a -> Either8 a b c d e f g b
f = a -> Either8 a b c d e f g b
f a
a

instance Monad (Either9 a b c d e f g h) where
  E9_1 a
a >>= :: forall a b.
Either9 a b c d e f g h a
-> (a -> Either9 a b c d e f g h b) -> Either9 a b c d e f g h b
>>= a -> Either9 a b c d e f g h b
_ = forall a b c d e f g h i. a -> Either9 a b c d e f g h i
E9_1 a
a
  E9_2 b
a >>= a -> Either9 a b c d e f g h b
_ = forall a b c d e f g h i. b -> Either9 a b c d e f g h i
E9_2 b
a
  E9_3 c
a >>= a -> Either9 a b c d e f g h b
_ = forall a b c d e f g h i. c -> Either9 a b c d e f g h i
E9_3 c
a
  E9_4 d
a >>= a -> Either9 a b c d e f g h b
_ = forall a b c d e f g h i. d -> Either9 a b c d e f g h i
E9_4 d
a
  E9_5 e
a >>= a -> Either9 a b c d e f g h b
_ = forall a b c d e f g h i. e -> Either9 a b c d e f g h i
E9_5 e
a
  E9_6 f
a >>= a -> Either9 a b c d e f g h b
_ = forall a b c d e f g h i. f -> Either9 a b c d e f g h i
E9_6 f
a
  E9_7 g
a >>= a -> Either9 a b c d e f g h b
_ = forall a b c d e f g h i. g -> Either9 a b c d e f g h i
E9_7 g
a
  E9_8 h
a >>= a -> Either9 a b c d e f g h b
_ = forall a b c d e f g h i. h -> Either9 a b c d e f g h i
E9_8 h
a
  E9_9 a
a >>= a -> Either9 a b c d e f g h b
f = a -> Either9 a b c d e f g h b
f a
a

instance Monad (Either10 a b c d e f g h i) where
  E10_1 a
a >>= :: forall a b.
Either10 a b c d e f g h i a
-> (a -> Either10 a b c d e f g h i b)
-> Either10 a b c d e f g h i b
>>= a -> Either10 a b c d e f g h i b
_ = forall a b c d e f g h i j. a -> Either10 a b c d e f g h i j
E10_1 a
a
  E10_2 b
a >>= a -> Either10 a b c d e f g h i b
_ = forall a b c d e f g h i j. b -> Either10 a b c d e f g h i j
E10_2 b
a
  E10_3 c
a >>= a -> Either10 a b c d e f g h i b
_ = forall a b c d e f g h i j. c -> Either10 a b c d e f g h i j
E10_3 c
a
  E10_4 d
a >>= a -> Either10 a b c d e f g h i b
_ = forall a b c d e f g h i j. d -> Either10 a b c d e f g h i j
E10_4 d
a
  E10_5 e
a >>= a -> Either10 a b c d e f g h i b
_ = forall a b c d e f g h i j. e -> Either10 a b c d e f g h i j
E10_5 e
a
  E10_6 f
a >>= a -> Either10 a b c d e f g h i b
_ = forall a b c d e f g h i j. f -> Either10 a b c d e f g h i j
E10_6 f
a
  E10_7 g
a >>= a -> Either10 a b c d e f g h i b
_ = forall a b c d e f g h i j. g -> Either10 a b c d e f g h i j
E10_7 g
a
  E10_8 h
a >>= a -> Either10 a b c d e f g h i b
_ = forall a b c d e f g h i j. h -> Either10 a b c d e f g h i j
E10_8 h
a
  E10_9 i
a >>= a -> Either10 a b c d e f g h i b
_ = forall a b c d e f g h i j. i -> Either10 a b c d e f g h i j
E10_9 i
a
  E10_10 a
a >>= a -> Either10 a b c d e f g h i b
f = a -> Either10 a b c d e f g h i b
f a
a

instance Bifoldable (Either3 a) where
  bifoldMap :: forall m a b.
Monoid m =>
(a -> m) -> (b -> m) -> Either3 a a b -> m
bifoldMap a -> m
f b -> m
_ (E3_2 a
a) = a -> m
f a
a
  bifoldMap a -> m
_ b -> m
g (E3_3 b
a) = b -> m
g b
a
  bifoldMap a -> m
_ b -> m
_ Either3 a a b
_        = forall a. Monoid a => a
mempty

instance Bifoldable (Either4 a b) where
  bifoldMap :: forall m a b.
Monoid m =>
(a -> m) -> (b -> m) -> Either4 a b a b -> m
bifoldMap a -> m
f b -> m
_ (E4_3 a
a) = a -> m
f a
a
  bifoldMap a -> m
_ b -> m
g (E4_4 b
a) = b -> m
g b
a
  bifoldMap a -> m
_ b -> m
_ Either4 a b a b
_        = forall a. Monoid a => a
mempty

instance Bifoldable (Either5 a b c) where
  bifoldMap :: forall m a b.
Monoid m =>
(a -> m) -> (b -> m) -> Either5 a b c a b -> m
bifoldMap a -> m
f b -> m
_ (E5_4 a
a) = a -> m
f a
a
  bifoldMap a -> m
_ b -> m
g (E5_5 b
a) = b -> m
g b
a
  bifoldMap a -> m
_ b -> m
_ Either5 a b c a b
_        = forall a. Monoid a => a
mempty

instance Bifoldable (Either6 a b c d) where
  bifoldMap :: forall m a b.
Monoid m =>
(a -> m) -> (b -> m) -> Either6 a b c d a b -> m
bifoldMap a -> m
f b -> m
_ (E6_5 a
a) = a -> m
f a
a
  bifoldMap a -> m
_ b -> m
g (E6_6 b
a) = b -> m
g b
a
  bifoldMap a -> m
_ b -> m
_ Either6 a b c d a b
_        = forall a. Monoid a => a
mempty

instance Bifoldable (Either7 a b c d e) where
  bifoldMap :: forall m a b.
Monoid m =>
(a -> m) -> (b -> m) -> Either7 a b c d e a b -> m
bifoldMap a -> m
f b -> m
_ (E7_6 a
a) = a -> m
f a
a
  bifoldMap a -> m
_ b -> m
g (E7_7 b
a) = b -> m
g b
a
  bifoldMap a -> m
_ b -> m
_ Either7 a b c d e a b
_        = forall a. Monoid a => a
mempty

instance Bifoldable (Either8 a b c d e f) where
  bifoldMap :: forall m a b.
Monoid m =>
(a -> m) -> (b -> m) -> Either8 a b c d e f a b -> m
bifoldMap a -> m
f b -> m
_ (E8_7 a
a) = a -> m
f a
a
  bifoldMap a -> m
_ b -> m
g (E8_8 b
a) = b -> m
g b
a
  bifoldMap a -> m
_ b -> m
_ Either8 a b c d e f a b
_        = forall a. Monoid a => a
mempty

instance Bifoldable (Either9 a b c d e f g) where
  bifoldMap :: forall m a b.
Monoid m =>
(a -> m) -> (b -> m) -> Either9 a b c d e f g a b -> m
bifoldMap a -> m
f b -> m
_ (E9_8 a
a) = a -> m
f a
a
  bifoldMap a -> m
_ b -> m
g (E9_9 b
a) = b -> m
g b
a
  bifoldMap a -> m
_ b -> m
_ Either9 a b c d e f g a b
_        = forall a. Monoid a => a
mempty

instance Bifoldable (Either10 a b c d e f g h) where
  bifoldMap :: forall m a b.
Monoid m =>
(a -> m) -> (b -> m) -> Either10 a b c d e f g h a b -> m
bifoldMap a -> m
f b -> m
_ (E10_9 a
a)  = a -> m
f a
a
  bifoldMap a -> m
_ b -> m
g (E10_10 b
a) = b -> m
g b
a
  bifoldMap a -> m
_ b -> m
_ Either10 a b c d e f g h a b
_          = forall a. Monoid a => a
mempty

instance Bitraversable (Either3 a) where
  bitraverse :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Either3 a a b -> f (Either3 a c d)
bitraverse a -> f c
_ b -> f d
_ (E3_1 a
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b c. a -> Either3 a b c
E3_1 a
a)
  bitraverse a -> f c
f b -> f d
_ (E3_2 a
a) = forall a b c. b -> Either3 a b c
E3_2 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
a
  bitraverse a -> f c
_ b -> f d
g (E3_3 b
a) = forall a b a. a -> Either3 a b a
E3_3 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f d
g b
a

instance Bitraversable (Either4 a b) where
  bitraverse :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Either4 a b a b -> f (Either4 a b c d)
bitraverse a -> f c
_ b -> f d
_ (E4_1 a
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b c d. a -> Either4 a b c d
E4_1 a
a)
  bitraverse a -> f c
_ b -> f d
_ (E4_2 b
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b c d. b -> Either4 a b c d
E4_2 b
a)
  bitraverse a -> f c
f b -> f d
_ (E4_3 a
a) = forall a b c d. c -> Either4 a b c d
E4_3 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
a
  bitraverse a -> f c
_ b -> f d
g (E4_4 b
a) = forall a b c a. a -> Either4 a b c a
E4_4 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f d
g b
a

instance Bitraversable (Either5 a b c) where
  bitraverse :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c)
-> (b -> f d) -> Either5 a b c a b -> f (Either5 a b c c d)
bitraverse a -> f c
_ b -> f d
_ (E5_1 a
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b c d e. a -> Either5 a b c d e
E5_1 a
a)
  bitraverse a -> f c
_ b -> f d
_ (E5_2 b
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b c d e. b -> Either5 a b c d e
E5_2 b
a)
  bitraverse a -> f c
_ b -> f d
_ (E5_3 c
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b c d e. c -> Either5 a b c d e
E5_3 c
a)
  bitraverse a -> f c
f b -> f d
_ (E5_4 a
a) = forall a b c d e. d -> Either5 a b c d e
E5_4 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
a
  bitraverse a -> f c
_ b -> f d
g (E5_5 b
a) = forall a b c d a. a -> Either5 a b c d a
E5_5 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f d
g b
a

instance Bitraversable (Either6 a b c d) where
  bitraverse :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c)
-> (b -> f d) -> Either6 a b c d a b -> f (Either6 a b c d c d)
bitraverse a -> f c
_ b -> f d
_ (E6_1 a
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b c d e f. a -> Either6 a b c d e f
E6_1 a
a)
  bitraverse a -> f c
_ b -> f d
_ (E6_2 b
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b c d e f. b -> Either6 a b c d e f
E6_2 b
a)
  bitraverse a -> f c
_ b -> f d
_ (E6_3 c
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b c d e f. c -> Either6 a b c d e f
E6_3 c
a)
  bitraverse a -> f c
_ b -> f d
_ (E6_4 d
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b c d e f. d -> Either6 a b c d e f
E6_4 d
a)
  bitraverse a -> f c
f b -> f d
_ (E6_5 a
a) = forall a b c d e f. e -> Either6 a b c d e f
E6_5 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
a
  bitraverse a -> f c
_ b -> f d
g (E6_6 b
a) = forall a b c d e a. a -> Either6 a b c d e a
E6_6 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f d
g b
a

instance Bitraversable (Either7 a b c d e) where
  bitraverse :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c)
-> (b -> f d) -> Either7 a b c d e a b -> f (Either7 a b c d e c d)
bitraverse a -> f c
_ b -> f d
_ (E7_1 a
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b c d e f g. a -> Either7 a b c d e f g
E7_1 a
a)
  bitraverse a -> f c
_ b -> f d
_ (E7_2 b
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b c d e f g. b -> Either7 a b c d e f g
E7_2 b
a)
  bitraverse a -> f c
_ b -> f d
_ (E7_3 c
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b c d e f g. c -> Either7 a b c d e f g
E7_3 c
a)
  bitraverse a -> f c
_ b -> f d
_ (E7_4 d
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b c d e f g. d -> Either7 a b c d e f g
E7_4 d
a)
  bitraverse a -> f c
_ b -> f d
_ (E7_5 e
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b c d e f g. e -> Either7 a b c d e f g
E7_5 e
a)
  bitraverse a -> f c
f b -> f d
_ (E7_6 a
a) = forall a b c d e f g. f -> Either7 a b c d e f g
E7_6 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
a
  bitraverse a -> f c
_ b -> f d
g (E7_7 b
a) = forall a b c d e f a. a -> Either7 a b c d e f a
E7_7 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f d
g b
a

instance Bitraversable (Either8 a b c d e f) where
  bitraverse :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c)
-> (b -> f d)
-> Either8 a b c d e f a b
-> f (Either8 a b c d e f c d)
bitraverse a -> f c
_ b -> f d
_ (E8_1 a
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b c d e f g h. a -> Either8 a b c d e f g h
E8_1 a
a)
  bitraverse a -> f c
_ b -> f d
_ (E8_2 b
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b c d e f g h. b -> Either8 a b c d e f g h
E8_2 b
a)
  bitraverse a -> f c
_ b -> f d
_ (E8_3 c
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b c d e f g h. c -> Either8 a b c d e f g h
E8_3 c
a)
  bitraverse a -> f c
_ b -> f d
_ (E8_4 d
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b c d e f g h. d -> Either8 a b c d e f g h
E8_4 d
a)
  bitraverse a -> f c
_ b -> f d
_ (E8_5 e
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b c d e f g h. e -> Either8 a b c d e f g h
E8_5 e
a)
  bitraverse a -> f c
_ b -> f d
_ (E8_6 f
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b c d e f g h. f -> Either8 a b c d e f g h
E8_6 f
a)
  bitraverse a -> f c
f b -> f d
_ (E8_7 a
a) = forall a b c d e f g h. g -> Either8 a b c d e f g h
E8_7 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
a
  bitraverse a -> f c
_ b -> f d
g (E8_8 b
a) = forall a b c d e f g a. a -> Either8 a b c d e f g a
E8_8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f d
g b
a

instance Bitraversable (Either9 a b c d e f g) where
  bitraverse :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c)
-> (b -> f d)
-> Either9 a b c d e f g a b
-> f (Either9 a b c d e f g c d)
bitraverse a -> f c
_ b -> f d
_ (E9_1 a
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b c d e f g h i. a -> Either9 a b c d e f g h i
E9_1 a
a)
  bitraverse a -> f c
_ b -> f d
_ (E9_2 b
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b c d e f g h i. b -> Either9 a b c d e f g h i
E9_2 b
a)
  bitraverse a -> f c
_ b -> f d
_ (E9_3 c
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b c d e f g h i. c -> Either9 a b c d e f g h i
E9_3 c
a)
  bitraverse a -> f c
_ b -> f d
_ (E9_4 d
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b c d e f g h i. d -> Either9 a b c d e f g h i
E9_4 d
a)
  bitraverse a -> f c
_ b -> f d
_ (E9_5 e
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b c d e f g h i. e -> Either9 a b c d e f g h i
E9_5 e
a)
  bitraverse a -> f c
_ b -> f d
_ (E9_6 f
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b c d e f g h i. f -> Either9 a b c d e f g h i
E9_6 f
a)
  bitraverse a -> f c
_ b -> f d
_ (E9_7 g
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b c d e f g h i. g -> Either9 a b c d e f g h i
E9_7 g
a)
  bitraverse a -> f c
f b -> f d
_ (E9_8 a
a) = forall a b c d e f g h i. h -> Either9 a b c d e f g h i
E9_8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
a
  bitraverse a -> f c
_ b -> f d
g (E9_9 b
a) = forall a b c d e f g h a. a -> Either9 a b c d e f g h a
E9_9 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f d
g b
a

instance Bitraversable (Either10 a b c d e f g h) where
  bitraverse :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c)
-> (b -> f d)
-> Either10 a b c d e f g h a b
-> f (Either10 a b c d e f g h c d)
bitraverse a -> f c
_ b -> f d
_ (E10_1 a
a)  = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b c d e f g h i j. a -> Either10 a b c d e f g h i j
E10_1 a
a)
  bitraverse a -> f c
_ b -> f d
_ (E10_2 b
a)  = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b c d e f g h i j. b -> Either10 a b c d e f g h i j
E10_2 b
a)
  bitraverse a -> f c
_ b -> f d
_ (E10_3 c
a)  = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b c d e f g h i j. c -> Either10 a b c d e f g h i j
E10_3 c
a)
  bitraverse a -> f c
_ b -> f d
_ (E10_4 d
a)  = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b c d e f g h i j. d -> Either10 a b c d e f g h i j
E10_4 d
a)
  bitraverse a -> f c
_ b -> f d
_ (E10_5 e
a)  = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b c d e f g h i j. e -> Either10 a b c d e f g h i j
E10_5 e
a)
  bitraverse a -> f c
_ b -> f d
_ (E10_6 f
a)  = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b c d e f g h i j. f -> Either10 a b c d e f g h i j
E10_6 f
a)
  bitraverse a -> f c
_ b -> f d
_ (E10_7 g
a)  = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b c d e f g h i j. g -> Either10 a b c d e f g h i j
E10_7 g
a)
  bitraverse a -> f c
_ b -> f d
_ (E10_8 h
a)  = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b c d e f g h i j. h -> Either10 a b c d e f g h i j
E10_8 h
a)
  bitraverse a -> f c
f b -> f d
_ (E10_9 a
a)  = forall a b c d e f g h i j. i -> Either10 a b c d e f g h i j
E10_9 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
a
  bitraverse a -> f c
_ b -> f d
g (E10_10 b
a) = forall a b c d e f g h i a. a -> Either10 a b c d e f g h i a
E10_10 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f d
g b
a

instance (HasAvroSchema a, HasAvroSchema b, HasAvroSchema c) => HasAvroSchema (Either3 a b c) where
  schema :: Tagged (Either3 a b c) Schema
schema = forall {k} (s :: k) b. b -> Tagged s b
Tagged forall a b. (a -> b) -> a -> b
$ NonEmpty Schema -> Schema
mkUnion (forall {k} (s :: k) b. Tagged s b -> b
untag @a forall a. HasAvroSchema a => Tagged a Schema
schema forall a. a -> [a] -> NonEmpty a
:| [
                             forall {k} (s :: k) b. Tagged s b -> b
untag @b forall a. HasAvroSchema a => Tagged a Schema
schema,
                             forall {k} (s :: k) b. Tagged s b -> b
untag @c forall a. HasAvroSchema a => Tagged a Schema
schema
                            ])

instance (HasAvroSchema a, HasAvroSchema b, HasAvroSchema c, HasAvroSchema d) => HasAvroSchema (Either4 a b c d) where
  schema :: Tagged (Either4 a b c d) Schema
schema = forall {k} (s :: k) b. b -> Tagged s b
Tagged forall a b. (a -> b) -> a -> b
$ NonEmpty Schema -> Schema
mkUnion (forall {k} (s :: k) b. Tagged s b -> b
untag @a forall a. HasAvroSchema a => Tagged a Schema
schema forall a. a -> [a] -> NonEmpty a
:| [
                             forall {k} (s :: k) b. Tagged s b -> b
untag @b forall a. HasAvroSchema a => Tagged a Schema
schema,
                             forall {k} (s :: k) b. Tagged s b -> b
untag @c forall a. HasAvroSchema a => Tagged a Schema
schema,
                             forall {k} (s :: k) b. Tagged s b -> b
untag @d forall a. HasAvroSchema a => Tagged a Schema
schema
                            ])

instance (HasAvroSchema a, HasAvroSchema b, HasAvroSchema c, HasAvroSchema d, HasAvroSchema e) => HasAvroSchema (Either5 a b c d e) where
  schema :: Tagged (Either5 a b c d e) Schema
schema = forall {k} (s :: k) b. b -> Tagged s b
Tagged forall a b. (a -> b) -> a -> b
$ NonEmpty Schema -> Schema
mkUnion (forall {k} (s :: k) b. Tagged s b -> b
untag @a forall a. HasAvroSchema a => Tagged a Schema
schema forall a. a -> [a] -> NonEmpty a
:| [
                             forall {k} (s :: k) b. Tagged s b -> b
untag @b forall a. HasAvroSchema a => Tagged a Schema
schema,
                             forall {k} (s :: k) b. Tagged s b -> b
untag @c forall a. HasAvroSchema a => Tagged a Schema
schema,
                             forall {k} (s :: k) b. Tagged s b -> b
untag @d forall a. HasAvroSchema a => Tagged a Schema
schema,
                             forall {k} (s :: k) b. Tagged s b -> b
untag @e forall a. HasAvroSchema a => Tagged a Schema
schema
                            ])

instance (HasAvroSchema a, HasAvroSchema b, HasAvroSchema c, HasAvroSchema d, HasAvroSchema e, HasAvroSchema f)
  => HasAvroSchema (Either6 a b c d e f) where
    schema :: Tagged (Either6 a b c d e f) Schema
schema = forall {k} (s :: k) b. b -> Tagged s b
Tagged forall a b. (a -> b) -> a -> b
$ NonEmpty Schema -> Schema
mkUnion (forall {k} (s :: k) b. Tagged s b -> b
untag @a forall a. HasAvroSchema a => Tagged a Schema
schema forall a. a -> [a] -> NonEmpty a
:| [
                               forall {k} (s :: k) b. Tagged s b -> b
untag @b forall a. HasAvroSchema a => Tagged a Schema
schema,
                               forall {k} (s :: k) b. Tagged s b -> b
untag @c forall a. HasAvroSchema a => Tagged a Schema
schema,
                               forall {k} (s :: k) b. Tagged s b -> b
untag @d forall a. HasAvroSchema a => Tagged a Schema
schema,
                               forall {k} (s :: k) b. Tagged s b -> b
untag @e forall a. HasAvroSchema a => Tagged a Schema
schema,
                               forall {k} (s :: k) b. Tagged s b -> b
untag @f forall a. HasAvroSchema a => Tagged a Schema
schema
                              ])

instance (HasAvroSchema a, HasAvroSchema b, HasAvroSchema c, HasAvroSchema d, HasAvroSchema e, HasAvroSchema f, HasAvroSchema g)
  => HasAvroSchema (Either7 a b c d e f g) where
    schema :: Tagged (Either7 a b c d e f g) Schema
schema = forall {k} (s :: k) b. b -> Tagged s b
Tagged forall a b. (a -> b) -> a -> b
$ NonEmpty Schema -> Schema
mkUnion (forall {k} (s :: k) b. Tagged s b -> b
untag @a forall a. HasAvroSchema a => Tagged a Schema
schema forall a. a -> [a] -> NonEmpty a
:| [
                               forall {k} (s :: k) b. Tagged s b -> b
untag @b forall a. HasAvroSchema a => Tagged a Schema
schema,
                               forall {k} (s :: k) b. Tagged s b -> b
untag @c forall a. HasAvroSchema a => Tagged a Schema
schema,
                               forall {k} (s :: k) b. Tagged s b -> b
untag @d forall a. HasAvroSchema a => Tagged a Schema
schema,
                               forall {k} (s :: k) b. Tagged s b -> b
untag @e forall a. HasAvroSchema a => Tagged a Schema
schema,
                               forall {k} (s :: k) b. Tagged s b -> b
untag @f forall a. HasAvroSchema a => Tagged a Schema
schema,
                               forall {k} (s :: k) b. Tagged s b -> b
untag @g forall a. HasAvroSchema a => Tagged a Schema
schema
                              ])

instance (HasAvroSchema a, HasAvroSchema b, HasAvroSchema c, HasAvroSchema d, HasAvroSchema e, HasAvroSchema f, HasAvroSchema g, HasAvroSchema h)
  => HasAvroSchema (Either8 a b c d e f g h) where
    schema :: Tagged (Either8 a b c d e f g h) Schema
schema = forall {k} (s :: k) b. b -> Tagged s b
Tagged forall a b. (a -> b) -> a -> b
$ NonEmpty Schema -> Schema
mkUnion (forall {k} (s :: k) b. Tagged s b -> b
untag @a forall a. HasAvroSchema a => Tagged a Schema
schema forall a. a -> [a] -> NonEmpty a
:| [
                               forall {k} (s :: k) b. Tagged s b -> b
untag @b forall a. HasAvroSchema a => Tagged a Schema
schema,
                               forall {k} (s :: k) b. Tagged s b -> b
untag @c forall a. HasAvroSchema a => Tagged a Schema
schema,
                               forall {k} (s :: k) b. Tagged s b -> b
untag @d forall a. HasAvroSchema a => Tagged a Schema
schema,
                               forall {k} (s :: k) b. Tagged s b -> b
untag @e forall a. HasAvroSchema a => Tagged a Schema
schema,
                               forall {k} (s :: k) b. Tagged s b -> b
untag @f forall a. HasAvroSchema a => Tagged a Schema
schema,
                               forall {k} (s :: k) b. Tagged s b -> b
untag @g forall a. HasAvroSchema a => Tagged a Schema
schema,
                               forall {k} (s :: k) b. Tagged s b -> b
untag @h forall a. HasAvroSchema a => Tagged a Schema
schema
                              ])

instance (HasAvroSchema a, HasAvroSchema b, HasAvroSchema c, HasAvroSchema d, HasAvroSchema e, HasAvroSchema f, HasAvroSchema g, HasAvroSchema h, HasAvroSchema i)
  => HasAvroSchema (Either9 a b c d e f g h i) where
    schema :: Tagged (Either9 a b c d e f g h i) Schema
schema = forall {k} (s :: k) b. b -> Tagged s b
Tagged forall a b. (a -> b) -> a -> b
$ NonEmpty Schema -> Schema
mkUnion (forall {k} (s :: k) b. Tagged s b -> b
untag @a forall a. HasAvroSchema a => Tagged a Schema
schema forall a. a -> [a] -> NonEmpty a
:| [
                               forall {k} (s :: k) b. Tagged s b -> b
untag @b forall a. HasAvroSchema a => Tagged a Schema
schema,
                               forall {k} (s :: k) b. Tagged s b -> b
untag @c forall a. HasAvroSchema a => Tagged a Schema
schema,
                               forall {k} (s :: k) b. Tagged s b -> b
untag @d forall a. HasAvroSchema a => Tagged a Schema
schema,
                               forall {k} (s :: k) b. Tagged s b -> b
untag @e forall a. HasAvroSchema a => Tagged a Schema
schema,
                               forall {k} (s :: k) b. Tagged s b -> b
untag @f forall a. HasAvroSchema a => Tagged a Schema
schema,
                               forall {k} (s :: k) b. Tagged s b -> b
untag @g forall a. HasAvroSchema a => Tagged a Schema
schema,
                               forall {k} (s :: k) b. Tagged s b -> b
untag @h forall a. HasAvroSchema a => Tagged a Schema
schema,
                               forall {k} (s :: k) b. Tagged s b -> b
untag @i forall a. HasAvroSchema a => Tagged a Schema
schema
                              ])

instance (HasAvroSchema a, HasAvroSchema b, HasAvroSchema c, HasAvroSchema d, HasAvroSchema e, HasAvroSchema f, HasAvroSchema g, HasAvroSchema h, HasAvroSchema i, HasAvroSchema j)
  => HasAvroSchema (Either10 a b c d e f g h i j) where
    schema :: Tagged (Either10 a b c d e f g h i j) Schema
schema = forall {k} (s :: k) b. b -> Tagged s b
Tagged forall a b. (a -> b) -> a -> b
$ NonEmpty Schema -> Schema
mkUnion (forall {k} (s :: k) b. Tagged s b -> b
untag @a forall a. HasAvroSchema a => Tagged a Schema
schema forall a. a -> [a] -> NonEmpty a
:| [
                               forall {k} (s :: k) b. Tagged s b -> b
untag @b forall a. HasAvroSchema a => Tagged a Schema
schema,
                               forall {k} (s :: k) b. Tagged s b -> b
untag @c forall a. HasAvroSchema a => Tagged a Schema
schema,
                               forall {k} (s :: k) b. Tagged s b -> b
untag @d forall a. HasAvroSchema a => Tagged a Schema
schema,
                               forall {k} (s :: k) b. Tagged s b -> b
untag @e forall a. HasAvroSchema a => Tagged a Schema
schema,
                               forall {k} (s :: k) b. Tagged s b -> b
untag @f forall a. HasAvroSchema a => Tagged a Schema
schema,
                               forall {k} (s :: k) b. Tagged s b -> b
untag @g forall a. HasAvroSchema a => Tagged a Schema
schema,
                               forall {k} (s :: k) b. Tagged s b -> b
untag @h forall a. HasAvroSchema a => Tagged a Schema
schema,
                               forall {k} (s :: k) b. Tagged s b -> b
untag @i forall a. HasAvroSchema a => Tagged a Schema
schema,
                               forall {k} (s :: k) b. Tagged s b -> b
untag @j forall a. HasAvroSchema a => Tagged a Schema
schema
                              ])

------------ DATA.AVRO.VALUE --------------------------------
instance (FromAvro a, FromAvro b, FromAvro c) => FromAvro (Either3 a b c) where
  fromAvro :: Value -> Either String (Either3 a b c)
fromAvro (AV.Union ReadSchema
_ Int
0 Value
a) = forall a b c. a -> Either3 a b c
E3_1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
a
  fromAvro (AV.Union ReadSchema
_ Int
1 Value
b) = forall a b c. b -> Either3 a b c
E3_2 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
b
  fromAvro (AV.Union ReadSchema
_ Int
2 Value
c) = forall a b a. a -> Either3 a b a
E3_3 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
c
  fromAvro (AV.Union ReadSchema
_ Int
n Value
_) = forall a b. a -> Either a b
Left (String
"Unable to decode Either3 from a position #" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
n)

instance (FromAvro a, FromAvro b, FromAvro c, FromAvro d) => FromAvro (Either4 a b c d) where
  fromAvro :: Value -> Either String (Either4 a b c d)
fromAvro (AV.Union ReadSchema
_ Int
0 Value
a) = forall a b c d. a -> Either4 a b c d
E4_1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
a
  fromAvro (AV.Union ReadSchema
_ Int
1 Value
b) = forall a b c d. b -> Either4 a b c d
E4_2 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
b
  fromAvro (AV.Union ReadSchema
_ Int
2 Value
c) = forall a b c d. c -> Either4 a b c d
E4_3 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
c
  fromAvro (AV.Union ReadSchema
_ Int
3 Value
d) = forall a b c a. a -> Either4 a b c a
E4_4 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
d
  fromAvro (AV.Union ReadSchema
_ Int
n Value
_) = forall a b. a -> Either a b
Left (String
"Unable to decode Either4 from a position #" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
n)

instance (FromAvro a, FromAvro b, FromAvro c, FromAvro d, FromAvro e) => FromAvro (Either5 a b c d e) where
  fromAvro :: Value -> Either String (Either5 a b c d e)
fromAvro (AV.Union ReadSchema
_ Int
0 Value
a) = forall a b c d e. a -> Either5 a b c d e
E5_1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
a
  fromAvro (AV.Union ReadSchema
_ Int
1 Value
b) = forall a b c d e. b -> Either5 a b c d e
E5_2 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
b
  fromAvro (AV.Union ReadSchema
_ Int
2 Value
c) = forall a b c d e. c -> Either5 a b c d e
E5_3 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
c
  fromAvro (AV.Union ReadSchema
_ Int
3 Value
d) = forall a b c d e. d -> Either5 a b c d e
E5_4 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
d
  fromAvro (AV.Union ReadSchema
_ Int
4 Value
e) = forall a b c d a. a -> Either5 a b c d a
E5_5 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
e
  fromAvro (AV.Union ReadSchema
_ Int
n Value
_) = forall a b. a -> Either a b
Left (String
"Unable to decode Either5 from a position #" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
n)

instance (FromAvro a, FromAvro b, FromAvro c, FromAvro d, FromAvro e, FromAvro f) => FromAvro (Either6 a b c d e f) where
  fromAvro :: Value -> Either String (Either6 a b c d e f)
fromAvro (AV.Union ReadSchema
_ Int
0 Value
a) = forall a b c d e f. a -> Either6 a b c d e f
E6_1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
a
  fromAvro (AV.Union ReadSchema
_ Int
1 Value
b) = forall a b c d e f. b -> Either6 a b c d e f
E6_2 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
b
  fromAvro (AV.Union ReadSchema
_ Int
2 Value
c) = forall a b c d e f. c -> Either6 a b c d e f
E6_3 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
c
  fromAvro (AV.Union ReadSchema
_ Int
3 Value
d) = forall a b c d e f. d -> Either6 a b c d e f
E6_4 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
d
  fromAvro (AV.Union ReadSchema
_ Int
4 Value
e) = forall a b c d e f. e -> Either6 a b c d e f
E6_5 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
e
  fromAvro (AV.Union ReadSchema
_ Int
5 Value
f) = forall a b c d e a. a -> Either6 a b c d e a
E6_6 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
f
  fromAvro (AV.Union ReadSchema
_ Int
n Value
_) = forall a b. a -> Either a b
Left (String
"Unable to decode Either6 from a position #" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
n)

instance (FromAvro a, FromAvro b, FromAvro c, FromAvro d, FromAvro e, FromAvro f, FromAvro g) => FromAvro (Either7 a b c d e f g) where
  fromAvro :: Value -> Either String (Either7 a b c d e f g)
fromAvro (AV.Union ReadSchema
_ Int
0 Value
a) = forall a b c d e f g. a -> Either7 a b c d e f g
E7_1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
a
  fromAvro (AV.Union ReadSchema
_ Int
1 Value
b) = forall a b c d e f g. b -> Either7 a b c d e f g
E7_2 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
b
  fromAvro (AV.Union ReadSchema
_ Int
2 Value
c) = forall a b c d e f g. c -> Either7 a b c d e f g
E7_3 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
c
  fromAvro (AV.Union ReadSchema
_ Int
3 Value
d) = forall a b c d e f g. d -> Either7 a b c d e f g
E7_4 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
d
  fromAvro (AV.Union ReadSchema
_ Int
4 Value
e) = forall a b c d e f g. e -> Either7 a b c d e f g
E7_5 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
e
  fromAvro (AV.Union ReadSchema
_ Int
5 Value
f) = forall a b c d e f g. f -> Either7 a b c d e f g
E7_6 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
f
  fromAvro (AV.Union ReadSchema
_ Int
6 Value
g) = forall a b c d e f a. a -> Either7 a b c d e f a
E7_7 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
g
  fromAvro (AV.Union ReadSchema
_ Int
n Value
_) = forall a b. a -> Either a b
Left (String
"Unable to decode Either7 from a position #" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
n)

instance (FromAvro a, FromAvro b, FromAvro c, FromAvro d, FromAvro e, FromAvro f, FromAvro g, FromAvro h) => FromAvro (Either8 a b c d e f g h) where
  fromAvro :: Value -> Either String (Either8 a b c d e f g h)
fromAvro (AV.Union ReadSchema
_ Int
0 Value
a) = forall a b c d e f g h. a -> Either8 a b c d e f g h
E8_1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
a
  fromAvro (AV.Union ReadSchema
_ Int
1 Value
b) = forall a b c d e f g h. b -> Either8 a b c d e f g h
E8_2 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
b
  fromAvro (AV.Union ReadSchema
_ Int
2 Value
c) = forall a b c d e f g h. c -> Either8 a b c d e f g h
E8_3 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
c
  fromAvro (AV.Union ReadSchema
_ Int
3 Value
d) = forall a b c d e f g h. d -> Either8 a b c d e f g h
E8_4 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
d
  fromAvro (AV.Union ReadSchema
_ Int
4 Value
e) = forall a b c d e f g h. e -> Either8 a b c d e f g h
E8_5 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
e
  fromAvro (AV.Union ReadSchema
_ Int
5 Value
f) = forall a b c d e f g h. f -> Either8 a b c d e f g h
E8_6 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
f
  fromAvro (AV.Union ReadSchema
_ Int
6 Value
g) = forall a b c d e f g h. g -> Either8 a b c d e f g h
E8_7 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
g
  fromAvro (AV.Union ReadSchema
_ Int
7 Value
h) = forall a b c d e f g a. a -> Either8 a b c d e f g a
E8_8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
h
  fromAvro (AV.Union ReadSchema
_ Int
n Value
_) = forall a b. a -> Either a b
Left (String
"Unable to decode Either8 from a position #" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
n)

instance (FromAvro a, FromAvro b, FromAvro c, FromAvro d, FromAvro e, FromAvro f, FromAvro g, FromAvro h, FromAvro i) => FromAvro (Either9 a b c d e f g h i) where
  fromAvro :: Value -> Either String (Either9 a b c d e f g h i)
fromAvro (AV.Union ReadSchema
_ Int
0 Value
a) = forall a b c d e f g h i. a -> Either9 a b c d e f g h i
E9_1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
a
  fromAvro (AV.Union ReadSchema
_ Int
1 Value
b) = forall a b c d e f g h i. b -> Either9 a b c d e f g h i
E9_2 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
b
  fromAvro (AV.Union ReadSchema
_ Int
2 Value
c) = forall a b c d e f g h i. c -> Either9 a b c d e f g h i
E9_3 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
c
  fromAvro (AV.Union ReadSchema
_ Int
3 Value
d) = forall a b c d e f g h i. d -> Either9 a b c d e f g h i
E9_4 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
d
  fromAvro (AV.Union ReadSchema
_ Int
4 Value
e) = forall a b c d e f g h i. e -> Either9 a b c d e f g h i
E9_5 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
e
  fromAvro (AV.Union ReadSchema
_ Int
5 Value
f) = forall a b c d e f g h i. f -> Either9 a b c d e f g h i
E9_6 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
f
  fromAvro (AV.Union ReadSchema
_ Int
6 Value
g) = forall a b c d e f g h i. g -> Either9 a b c d e f g h i
E9_7 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
g
  fromAvro (AV.Union ReadSchema
_ Int
7 Value
h) = forall a b c d e f g h i. h -> Either9 a b c d e f g h i
E9_8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
h
  fromAvro (AV.Union ReadSchema
_ Int
8 Value
i) = forall a b c d e f g h a. a -> Either9 a b c d e f g h a
E9_9 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
i
  fromAvro (AV.Union ReadSchema
_ Int
n Value
_) = forall a b. a -> Either a b
Left (String
"Unable to decode Either9 from a position #" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
n)

instance (FromAvro a, FromAvro b, FromAvro c, FromAvro d, FromAvro e, FromAvro f, FromAvro g, FromAvro h, FromAvro i, FromAvro j) => FromAvro (Either10 a b c d e f g h i j) where
  fromAvro :: Value -> Either String (Either10 a b c d e f g h i j)
fromAvro (AV.Union ReadSchema
_ Int
0 Value
a) = forall a b c d e f g h i j. a -> Either10 a b c d e f g h i j
E10_1  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
a
  fromAvro (AV.Union ReadSchema
_ Int
1 Value
b) = forall a b c d e f g h i j. b -> Either10 a b c d e f g h i j
E10_2  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
b
  fromAvro (AV.Union ReadSchema
_ Int
2 Value
c) = forall a b c d e f g h i j. c -> Either10 a b c d e f g h i j
E10_3  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
c
  fromAvro (AV.Union ReadSchema
_ Int
3 Value
d) = forall a b c d e f g h i j. d -> Either10 a b c d e f g h i j
E10_4  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
d
  fromAvro (AV.Union ReadSchema
_ Int
4 Value
e) = forall a b c d e f g h i j. e -> Either10 a b c d e f g h i j
E10_5  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
e
  fromAvro (AV.Union ReadSchema
_ Int
5 Value
f) = forall a b c d e f g h i j. f -> Either10 a b c d e f g h i j
E10_6  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
f
  fromAvro (AV.Union ReadSchema
_ Int
6 Value
g) = forall a b c d e f g h i j. g -> Either10 a b c d e f g h i j
E10_7  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
g
  fromAvro (AV.Union ReadSchema
_ Int
7 Value
h) = forall a b c d e f g h i j. h -> Either10 a b c d e f g h i j
E10_8  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
h
  fromAvro (AV.Union ReadSchema
_ Int
8 Value
i) = forall a b c d e f g h i j. i -> Either10 a b c d e f g h i j
E10_9  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
i
  fromAvro (AV.Union ReadSchema
_ Int
9 Value
j) = forall a b c d e f g h i a. a -> Either10 a b c d e f g h i a
E10_10 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromAvro a => Value -> Either String a
fromAvro Value
j
  fromAvro (AV.Union ReadSchema
_ Int
n Value
_) = forall a b. a -> Either a b
Left (String
"Unable to decode Either10 from a position #" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
n)

putIndexedValue :: ToAvro a => Int -> V.Vector Schema -> a -> Builder
putIndexedValue :: forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
i Vector Schema
opts a
x = Int -> Builder
putI Int
i forall a. Semigroup a => a -> a -> a
<> forall a. ToAvro a => Schema -> a -> Builder
toAvro (forall a. Vector a -> Int -> a
V.unsafeIndex Vector Schema
opts Int
i) a
x
{-# INLINE putIndexedValue #-}

instance (ToAvro a, ToAvro b, ToAvro c) => ToAvro (Either3 a b c) where
  toAvro :: Schema -> Either3 a b c -> Builder
toAvro (S.Union Vector Schema
opts) Either3 a b c
v =
    if forall a. Vector a -> Int
V.length Vector Schema
opts forall a. Eq a => a -> a -> Bool
== Int
3
      then case Either3 a b c
v of
        E3_1 a
x -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
0 Vector Schema
opts a
x
        E3_2 b
x -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
1 Vector Schema
opts b
x
        E3_3 c
x -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
2 Vector Schema
opts c
x
      else forall a. HasCallStack => String -> a
error (String
"Unable to encode Either3 as " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Vector Schema
opts)
  toAvro Schema
s Either3 a b c
_ = forall a. HasCallStack => String -> a
error (String
"Unable to encode Either3 as " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Schema
s)

instance (ToAvro a, ToAvro b, ToAvro c, ToAvro d) => ToAvro (Either4 a b c d) where
  toAvro :: Schema -> Either4 a b c d -> Builder
toAvro (S.Union Vector Schema
opts) Either4 a b c d
v =
    if forall a. Vector a -> Int
V.length Vector Schema
opts forall a. Eq a => a -> a -> Bool
== Int
4
      then case Either4 a b c d
v of
        E4_1 a
x -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
0 Vector Schema
opts a
x
        E4_2 b
x -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
1 Vector Schema
opts b
x
        E4_3 c
x -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
2 Vector Schema
opts c
x
        E4_4 d
x -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
3 Vector Schema
opts d
x
      else forall a. HasCallStack => String -> a
error (String
"Unable to encode Either4 as " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Vector Schema
opts)
  toAvro Schema
s Either4 a b c d
_ = forall a. HasCallStack => String -> a
error (String
"Unable to encode Either4 as " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Schema
s)

instance (ToAvro a, ToAvro b, ToAvro c, ToAvro d, ToAvro e) => ToAvro (Either5 a b c d e) where
  toAvro :: Schema -> Either5 a b c d e -> Builder
toAvro (S.Union Vector Schema
opts) Either5 a b c d e
v =
    if forall a. Vector a -> Int
V.length Vector Schema
opts forall a. Eq a => a -> a -> Bool
== Int
5
      then case Either5 a b c d e
v of
        E5_1 a
x -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
0 Vector Schema
opts a
x
        E5_2 b
x -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
1 Vector Schema
opts b
x
        E5_3 c
x -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
2 Vector Schema
opts c
x
        E5_4 d
x -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
3 Vector Schema
opts d
x
        E5_5 e
x -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
4 Vector Schema
opts e
x
      else forall a. HasCallStack => String -> a
error (String
"Unable to encode Either5 as " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Vector Schema
opts)
  toAvro Schema
s Either5 a b c d e
_ = forall a. HasCallStack => String -> a
error (String
"Unable to encode Either5 as " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Schema
s)

instance (ToAvro a, ToAvro b, ToAvro c, ToAvro d, ToAvro e, ToAvro f) => ToAvro (Either6 a b c d e f) where
  toAvro :: Schema -> Either6 a b c d e f -> Builder
toAvro (S.Union Vector Schema
opts) Either6 a b c d e f
v =
    if forall a. Vector a -> Int
V.length Vector Schema
opts forall a. Eq a => a -> a -> Bool
== Int
6
      then case Either6 a b c d e f
v of
        E6_1 a
x -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
0 Vector Schema
opts a
x
        E6_2 b
x -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
1 Vector Schema
opts b
x
        E6_3 c
x -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
2 Vector Schema
opts c
x
        E6_4 d
x -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
3 Vector Schema
opts d
x
        E6_5 e
x -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
4 Vector Schema
opts e
x
        E6_6 f
x -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
5 Vector Schema
opts f
x
      else forall a. HasCallStack => String -> a
error (String
"Unable to encode Either6 as " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Vector Schema
opts)
  toAvro Schema
s Either6 a b c d e f
_ = forall a. HasCallStack => String -> a
error (String
"Unable to encode Either6 as " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Schema
s)

instance (ToAvro a, ToAvro b, ToAvro c, ToAvro d, ToAvro e, ToAvro f, ToAvro g) => ToAvro (Either7 a b c d e f g) where
  toAvro :: Schema -> Either7 a b c d e f g -> Builder
toAvro (S.Union Vector Schema
opts) Either7 a b c d e f g
v =
    if forall a. Vector a -> Int
V.length Vector Schema
opts forall a. Eq a => a -> a -> Bool
== Int
7
      then case Either7 a b c d e f g
v of
        E7_1 a
x -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
0 Vector Schema
opts a
x
        E7_2 b
x -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
1 Vector Schema
opts b
x
        E7_3 c
x -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
2 Vector Schema
opts c
x
        E7_4 d
x -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
3 Vector Schema
opts d
x
        E7_5 e
x -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
4 Vector Schema
opts e
x
        E7_6 f
x -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
5 Vector Schema
opts f
x
        E7_7 g
x -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
6 Vector Schema
opts g
x
      else forall a. HasCallStack => String -> a
error (String
"Unable to encode Either7 as " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Vector Schema
opts)
  toAvro Schema
s Either7 a b c d e f g
_ = forall a. HasCallStack => String -> a
error (String
"Unable to encode Either7 as " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Schema
s)

instance (ToAvro a, ToAvro b, ToAvro c, ToAvro d, ToAvro e, ToAvro f, ToAvro g, ToAvro h) => ToAvro (Either8 a b c d e f g h) where
  toAvro :: Schema -> Either8 a b c d e f g h -> Builder
toAvro (S.Union Vector Schema
opts) Either8 a b c d e f g h
v =
    if forall a. Vector a -> Int
V.length Vector Schema
opts forall a. Eq a => a -> a -> Bool
== Int
8
      then case Either8 a b c d e f g h
v of
        E8_1 a
x -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
0 Vector Schema
opts a
x
        E8_2 b
x -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
1 Vector Schema
opts b
x
        E8_3 c
x -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
2 Vector Schema
opts c
x
        E8_4 d
x -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
3 Vector Schema
opts d
x
        E8_5 e
x -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
4 Vector Schema
opts e
x
        E8_6 f
x -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
5 Vector Schema
opts f
x
        E8_7 g
x -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
6 Vector Schema
opts g
x
        E8_8 h
x -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
7 Vector Schema
opts h
x
      else forall a. HasCallStack => String -> a
error (String
"Unable to encode Either8 as " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Vector Schema
opts)
  toAvro Schema
s Either8 a b c d e f g h
_ = forall a. HasCallStack => String -> a
error (String
"Unable to encode Either8 as " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Schema
s)

instance (ToAvro a, ToAvro b, ToAvro c, ToAvro d, ToAvro e, ToAvro f, ToAvro g, ToAvro h, ToAvro i) => ToAvro (Either9 a b c d e f g h i) where
  toAvro :: Schema -> Either9 a b c d e f g h i -> Builder
toAvro (S.Union Vector Schema
opts) Either9 a b c d e f g h i
v =
    if forall a. Vector a -> Int
V.length Vector Schema
opts forall a. Eq a => a -> a -> Bool
== Int
9
      then case Either9 a b c d e f g h i
v of
        E9_1 a
x -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
0 Vector Schema
opts a
x
        E9_2 b
x -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
1 Vector Schema
opts b
x
        E9_3 c
x -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
2 Vector Schema
opts c
x
        E9_4 d
x -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
3 Vector Schema
opts d
x
        E9_5 e
x -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
4 Vector Schema
opts e
x
        E9_6 f
x -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
5 Vector Schema
opts f
x
        E9_7 g
x -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
6 Vector Schema
opts g
x
        E9_8 h
x -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
7 Vector Schema
opts h
x
        E9_9 i
x -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
8 Vector Schema
opts i
x
      else forall a. HasCallStack => String -> a
error (String
"Unable to encode Either9 as " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Vector Schema
opts)
  toAvro Schema
s Either9 a b c d e f g h i
_ = forall a. HasCallStack => String -> a
error (String
"Unable to encode Either9 as " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Schema
s)

instance (ToAvro a, ToAvro b, ToAvro c, ToAvro d, ToAvro e, ToAvro f, ToAvro g, ToAvro h, ToAvro i, ToAvro j) => ToAvro (Either10 a b c d e f g h i j) where
  toAvro :: Schema -> Either10 a b c d e f g h i j -> Builder
toAvro (S.Union Vector Schema
opts) Either10 a b c d e f g h i j
v =
    if forall a. Vector a -> Int
V.length Vector Schema
opts forall a. Eq a => a -> a -> Bool
== Int
10
      then case Either10 a b c d e f g h i j
v of
        E10_1 a
x  -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
0 Vector Schema
opts a
x
        E10_2 b
x  -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
1 Vector Schema
opts b
x
        E10_3 c
x  -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
2 Vector Schema
opts c
x
        E10_4 d
x  -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
3 Vector Schema
opts d
x
        E10_5 e
x  -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
4 Vector Schema
opts e
x
        E10_6 f
x  -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
5 Vector Schema
opts f
x
        E10_7 g
x  -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
6 Vector Schema
opts g
x
        E10_8 h
x  -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
7 Vector Schema
opts h
x
        E10_9 i
x  -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
8 Vector Schema
opts i
x
        E10_10 j
x -> forall a. ToAvro a => Int -> Vector Schema -> a -> Builder
putIndexedValue Int
9 Vector Schema
opts j
x
      else  forall a. HasCallStack => String -> a
error (String
"Unable to encode Either10 as " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Vector Schema
opts)
  toAvro Schema
s Either10 a b c d e f g h i j
_ = forall a. HasCallStack => String -> a
error (String
"Unable to encode Either10 as " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Schema
s)