{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFoldable     #-}
{-# LANGUAGE DeriveFunctor      #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE DeriveTraversable  #-}
{-# LANGUAGE FlexibleContexts   #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE Safe               #-}
module Data.Functor.These (
    These1 (..),
    ) where

import Data.Foldable        (Foldable)
import Data.Functor.Classes (Eq1 (..), Ord1 (..), Read1 (..), Show1 (..))
import Data.Monoid          (Monoid (..))
import Data.Semigroup       (Semigroup (..))
import Data.Traversable     (Traversable)
import GHC.Generics         (Generic)
import Prelude
       (Bool (..), Eq (..), Functor, Ord (..), Ordering (..), Read (..),
       Show (..), lex, readParen, return, seq, showChar, showParen, showString,
       ($), (&&), (.))

import qualified Data.Foldable  as F
import qualified Data.Foldable1 as F1

import Control.DeepSeq (NFData (..), NFData1 (..))

import GHC.Generics (Generic1)

import Data.Data     (Data)
import Data.Typeable (Typeable)

-------------------------------------------------------------------------------
-- These1
-------------------------------------------------------------------------------

data These1 f g a
    = This1 (f a)
    | That1 (g a)
    | These1 (f a) (g a)
  deriving ((forall a b. (a -> b) -> These1 f g a -> These1 f g b)
-> (forall a b. a -> These1 f g b -> These1 f g a)
-> Functor (These1 f g)
forall a b. a -> These1 f g b -> These1 f g a
forall a b. (a -> b) -> These1 f g a -> These1 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 (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
a -> These1 f g b -> These1 f g a
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> These1 f g a -> These1 f g b
$cfmap :: forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> These1 f g a -> These1 f g b
fmap :: forall a b. (a -> b) -> These1 f g a -> These1 f g b
$c<$ :: forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
a -> These1 f g b -> These1 f g a
<$ :: forall a b. a -> These1 f g b -> These1 f g a
Functor, (forall m. Monoid m => These1 f g m -> m)
-> (forall m a. Monoid m => (a -> m) -> These1 f g a -> m)
-> (forall m a. Monoid m => (a -> m) -> These1 f g a -> m)
-> (forall a b. (a -> b -> b) -> b -> These1 f g a -> b)
-> (forall a b. (a -> b -> b) -> b -> These1 f g a -> b)
-> (forall b a. (b -> a -> b) -> b -> These1 f g a -> b)
-> (forall b a. (b -> a -> b) -> b -> These1 f g a -> b)
-> (forall a. (a -> a -> a) -> These1 f g a -> a)
-> (forall a. (a -> a -> a) -> These1 f g a -> a)
-> (forall a. These1 f g a -> [a])
-> (forall a. These1 f g a -> Bool)
-> (forall a. These1 f g a -> Int)
-> (forall a. Eq a => a -> These1 f g a -> Bool)
-> (forall a. Ord a => These1 f g a -> a)
-> (forall a. Ord a => These1 f g a -> a)
-> (forall a. Num a => These1 f g a -> a)
-> (forall a. Num a => These1 f g a -> a)
-> Foldable (These1 f g)
forall a. Eq a => a -> These1 f g a -> Bool
forall a. Num a => These1 f g a -> a
forall a. Ord a => These1 f g a -> a
forall m. Monoid m => These1 f g m -> m
forall a. These1 f g a -> Bool
forall a. These1 f g a -> Int
forall a. These1 f g a -> [a]
forall a. (a -> a -> a) -> These1 f g a -> a
forall m a. Monoid m => (a -> m) -> These1 f g a -> m
forall b a. (b -> a -> b) -> b -> These1 f g a -> b
forall a b. (a -> b -> b) -> b -> These1 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
forall (f :: * -> *) (g :: * -> *) a.
(Foldable f, Foldable g, Eq a) =>
a -> These1 f g a -> Bool
forall (f :: * -> *) (g :: * -> *) a.
(Foldable f, Foldable g, Num a) =>
These1 f g a -> a
forall (f :: * -> *) (g :: * -> *) a.
(Foldable f, Foldable g, Ord a) =>
These1 f g a -> a
forall (f :: * -> *) (g :: * -> *) m.
(Foldable f, Foldable g, Monoid m) =>
These1 f g m -> m
forall (f :: * -> *) (g :: * -> *) a.
(Foldable f, Foldable g) =>
These1 f g a -> Bool
forall (f :: * -> *) (g :: * -> *) a.
(Foldable f, Foldable g) =>
These1 f g a -> Int
forall (f :: * -> *) (g :: * -> *) a.
(Foldable f, Foldable g) =>
These1 f g a -> [a]
forall (f :: * -> *) (g :: * -> *) a.
(Foldable f, Foldable g) =>
(a -> a -> a) -> These1 f g a -> a
forall (f :: * -> *) (g :: * -> *) m a.
(Foldable f, Foldable g, Monoid m) =>
(a -> m) -> These1 f g a -> m
forall (f :: * -> *) (g :: * -> *) b a.
(Foldable f, Foldable g) =>
(b -> a -> b) -> b -> These1 f g a -> b
forall (f :: * -> *) (g :: * -> *) a b.
(Foldable f, Foldable g) =>
(a -> b -> b) -> b -> These1 f g a -> b
$cfold :: forall (f :: * -> *) (g :: * -> *) m.
(Foldable f, Foldable g, Monoid m) =>
These1 f g m -> m
fold :: forall m. Monoid m => These1 f g m -> m
$cfoldMap :: forall (f :: * -> *) (g :: * -> *) m a.
(Foldable f, Foldable g, Monoid m) =>
(a -> m) -> These1 f g a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> These1 f g a -> m
$cfoldMap' :: forall (f :: * -> *) (g :: * -> *) m a.
(Foldable f, Foldable g, Monoid m) =>
(a -> m) -> These1 f g a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> These1 f g a -> m
$cfoldr :: forall (f :: * -> *) (g :: * -> *) a b.
(Foldable f, Foldable g) =>
(a -> b -> b) -> b -> These1 f g a -> b
foldr :: forall a b. (a -> b -> b) -> b -> These1 f g a -> b
$cfoldr' :: forall (f :: * -> *) (g :: * -> *) a b.
(Foldable f, Foldable g) =>
(a -> b -> b) -> b -> These1 f g a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> These1 f g a -> b
$cfoldl :: forall (f :: * -> *) (g :: * -> *) b a.
(Foldable f, Foldable g) =>
(b -> a -> b) -> b -> These1 f g a -> b
foldl :: forall b a. (b -> a -> b) -> b -> These1 f g a -> b
$cfoldl' :: forall (f :: * -> *) (g :: * -> *) b a.
(Foldable f, Foldable g) =>
(b -> a -> b) -> b -> These1 f g a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> These1 f g a -> b
$cfoldr1 :: forall (f :: * -> *) (g :: * -> *) a.
(Foldable f, Foldable g) =>
(a -> a -> a) -> These1 f g a -> a
foldr1 :: forall a. (a -> a -> a) -> These1 f g a -> a
$cfoldl1 :: forall (f :: * -> *) (g :: * -> *) a.
(Foldable f, Foldable g) =>
(a -> a -> a) -> These1 f g a -> a
foldl1 :: forall a. (a -> a -> a) -> These1 f g a -> a
$ctoList :: forall (f :: * -> *) (g :: * -> *) a.
(Foldable f, Foldable g) =>
These1 f g a -> [a]
toList :: forall a. These1 f g a -> [a]
$cnull :: forall (f :: * -> *) (g :: * -> *) a.
(Foldable f, Foldable g) =>
These1 f g a -> Bool
null :: forall a. These1 f g a -> Bool
$clength :: forall (f :: * -> *) (g :: * -> *) a.
(Foldable f, Foldable g) =>
These1 f g a -> Int
length :: forall a. These1 f g a -> Int
$celem :: forall (f :: * -> *) (g :: * -> *) a.
(Foldable f, Foldable g, Eq a) =>
a -> These1 f g a -> Bool
elem :: forall a. Eq a => a -> These1 f g a -> Bool
$cmaximum :: forall (f :: * -> *) (g :: * -> *) a.
(Foldable f, Foldable g, Ord a) =>
These1 f g a -> a
maximum :: forall a. Ord a => These1 f g a -> a
$cminimum :: forall (f :: * -> *) (g :: * -> *) a.
(Foldable f, Foldable g, Ord a) =>
These1 f g a -> a
minimum :: forall a. Ord a => These1 f g a -> a
$csum :: forall (f :: * -> *) (g :: * -> *) a.
(Foldable f, Foldable g, Num a) =>
These1 f g a -> a
sum :: forall a. Num a => These1 f g a -> a
$cproduct :: forall (f :: * -> *) (g :: * -> *) a.
(Foldable f, Foldable g, Num a) =>
These1 f g a -> a
product :: forall a. Num a => These1 f g a -> a
Foldable, Functor (These1 f g)
Foldable (These1 f g)
(Functor (These1 f g), Foldable (These1 f g)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> These1 f g a -> f (These1 f g b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    These1 f g (f a) -> f (These1 f g a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> These1 f g a -> m (These1 f g b))
-> (forall (m :: * -> *) a.
    Monad m =>
    These1 f g (m a) -> m (These1 f g a))
-> Traversable (These1 f g)
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 (m :: * -> *) a.
Monad m =>
These1 f g (m a) -> m (These1 f g a)
forall (f :: * -> *) a.
Applicative f =>
These1 f g (f a) -> f (These1 f g a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> These1 f g a -> m (These1 f g b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> These1 f g a -> f (These1 f g b)
forall (f :: * -> *) (g :: * -> *).
(Traversable f, Traversable g) =>
Functor (These1 f g)
forall (f :: * -> *) (g :: * -> *).
(Traversable f, Traversable g) =>
Foldable (These1 f g)
forall (f :: * -> *) (g :: * -> *) (m :: * -> *) a.
(Traversable f, Traversable g, Monad m) =>
These1 f g (m a) -> m (These1 f g a)
forall (f :: * -> *) (g :: * -> *) (f :: * -> *) a.
(Traversable f, Traversable g, Applicative f) =>
These1 f g (f a) -> f (These1 f g a)
forall (f :: * -> *) (g :: * -> *) (m :: * -> *) a b.
(Traversable f, Traversable g, Monad m) =>
(a -> m b) -> These1 f g a -> m (These1 f g b)
forall (f :: * -> *) (g :: * -> *) (f :: * -> *) a b.
(Traversable f, Traversable g, Applicative f) =>
(a -> f b) -> These1 f g a -> f (These1 f g b)
$ctraverse :: forall (f :: * -> *) (g :: * -> *) (f :: * -> *) a b.
(Traversable f, Traversable g, Applicative f) =>
(a -> f b) -> These1 f g a -> f (These1 f g b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> These1 f g a -> f (These1 f g b)
$csequenceA :: forall (f :: * -> *) (g :: * -> *) (f :: * -> *) a.
(Traversable f, Traversable g, Applicative f) =>
These1 f g (f a) -> f (These1 f g a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
These1 f g (f a) -> f (These1 f g a)
$cmapM :: forall (f :: * -> *) (g :: * -> *) (m :: * -> *) a b.
(Traversable f, Traversable g, Monad m) =>
(a -> m b) -> These1 f g a -> m (These1 f g b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> These1 f g a -> m (These1 f g b)
$csequence :: forall (f :: * -> *) (g :: * -> *) (m :: * -> *) a.
(Traversable f, Traversable g, Monad m) =>
These1 f g (m a) -> m (These1 f g a)
sequence :: forall (m :: * -> *) a.
Monad m =>
These1 f g (m a) -> m (These1 f g a)
Traversable, (forall x. These1 f g a -> Rep (These1 f g a) x)
-> (forall x. Rep (These1 f g a) x -> These1 f g a)
-> Generic (These1 f g a)
forall x. Rep (These1 f g a) x -> These1 f g a
forall x. These1 f g a -> Rep (These1 f g a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) (g :: * -> *) a x.
Rep (These1 f g a) x -> These1 f g a
forall (f :: * -> *) (g :: * -> *) a x.
These1 f g a -> Rep (These1 f g a) x
$cfrom :: forall (f :: * -> *) (g :: * -> *) a x.
These1 f g a -> Rep (These1 f g a) x
from :: forall x. These1 f g a -> Rep (These1 f g a) x
$cto :: forall (f :: * -> *) (g :: * -> *) a x.
Rep (These1 f g a) x -> These1 f g a
to :: forall x. Rep (These1 f g a) x -> These1 f g a
Generic, (forall a. These1 f g a -> Rep1 (These1 f g) a)
-> (forall a. Rep1 (These1 f g) a -> These1 f g a)
-> Generic1 (These1 f g)
forall a. Rep1 (These1 f g) a -> These1 f g a
forall a. These1 f g a -> Rep1 (These1 f g) a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
forall (f :: * -> *) (g :: * -> *) a.
Rep1 (These1 f g) a -> These1 f g a
forall (f :: * -> *) (g :: * -> *) a.
These1 f g a -> Rep1 (These1 f g) a
$cfrom1 :: forall (f :: * -> *) (g :: * -> *) a.
These1 f g a -> Rep1 (These1 f g) a
from1 :: forall a. These1 f g a -> Rep1 (These1 f g) a
$cto1 :: forall (f :: * -> *) (g :: * -> *) a.
Rep1 (These1 f g) a -> These1 f g a
to1 :: forall a. Rep1 (These1 f g) a -> These1 f g a
Generic1, Typeable, Typeable (These1 f g a)
Typeable (These1 f g a) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> These1 f g a -> c (These1 f g a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (These1 f g a))
-> (These1 f g a -> Constr)
-> (These1 f g a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (These1 f g a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (These1 f g a)))
-> ((forall b. Data b => b -> b) -> These1 f g a -> These1 f g a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> These1 f g a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> These1 f g a -> r)
-> (forall u. (forall d. Data d => d -> u) -> These1 f g a -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> These1 f g a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> These1 f g a -> m (These1 f g a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> These1 f g a -> m (These1 f g a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> These1 f g a -> m (These1 f g a))
-> Data (These1 f g a)
These1 f g a -> Constr
These1 f g a -> DataType
(forall b. Data b => b -> b) -> These1 f g a -> These1 f g a
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> These1 f g a -> u
forall u. (forall d. Data d => d -> u) -> These1 f g a -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> These1 f g a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> These1 f g a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> These1 f g a -> m (These1 f g a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> These1 f g a -> m (These1 f g a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (These1 f g a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> These1 f g a -> c (These1 f g a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (These1 f g a))
forall (f :: * -> *) (g :: * -> *) a.
(Typeable f, Typeable g, Typeable a, Data (f a), Data (g a)) =>
Typeable (These1 f g a)
forall (f :: * -> *) (g :: * -> *) a.
(Typeable f, Typeable g, Typeable a, Data (f a), Data (g a)) =>
These1 f g a -> Constr
forall (f :: * -> *) (g :: * -> *) a.
(Typeable f, Typeable g, Typeable a, Data (f a), Data (g a)) =>
These1 f g a -> DataType
forall (f :: * -> *) (g :: * -> *) a.
(Typeable f, Typeable g, Typeable a, Data (f a), Data (g a)) =>
(forall b. Data b => b -> b) -> These1 f g a -> These1 f g a
forall (f :: * -> *) (g :: * -> *) a u.
(Typeable f, Typeable g, Typeable a, Data (f a), Data (g a)) =>
Int -> (forall d. Data d => d -> u) -> These1 f g a -> u
forall (f :: * -> *) (g :: * -> *) a u.
(Typeable f, Typeable g, Typeable a, Data (f a), Data (g a)) =>
(forall d. Data d => d -> u) -> These1 f g a -> [u]
forall (f :: * -> *) (g :: * -> *) a r r'.
(Typeable f, Typeable g, Typeable a, Data (f a), Data (g a)) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> These1 f g a -> r
forall (f :: * -> *) (g :: * -> *) a r r'.
(Typeable f, Typeable g, Typeable a, Data (f a), Data (g a)) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> These1 f g a -> r
forall (f :: * -> *) (g :: * -> *) a (m :: * -> *).
(Typeable f, Typeable g, Typeable a, Data (f a), Data (g a),
 Monad m) =>
(forall d. Data d => d -> m d) -> These1 f g a -> m (These1 f g a)
forall (f :: * -> *) (g :: * -> *) a (m :: * -> *).
(Typeable f, Typeable g, Typeable a, Data (f a), Data (g a),
 MonadPlus m) =>
(forall d. Data d => d -> m d) -> These1 f g a -> m (These1 f g a)
forall (f :: * -> *) (g :: * -> *) a (c :: * -> *).
(Typeable f, Typeable g, Typeable a, Data (f a), Data (g a)) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (These1 f g a)
forall (f :: * -> *) (g :: * -> *) a (c :: * -> *).
(Typeable f, Typeable g, Typeable a, Data (f a), Data (g a)) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> These1 f g a -> c (These1 f g a)
forall (f :: * -> *) (g :: * -> *) a (t :: * -> *) (c :: * -> *).
(Typeable f, Typeable g, Typeable a, Data (f a), Data (g a),
 Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (These1 f g a))
forall (f :: * -> *) (g :: * -> *) a (t :: * -> * -> *)
       (c :: * -> *).
(Typeable f, Typeable g, Typeable a, Data (f a), Data (g a),
 Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (These1 f g a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (These1 f g a))
$cgfoldl :: forall (f :: * -> *) (g :: * -> *) a (c :: * -> *).
(Typeable f, Typeable g, Typeable a, Data (f a), Data (g a)) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> These1 f g a -> c (These1 f g a)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> These1 f g a -> c (These1 f g a)
$cgunfold :: forall (f :: * -> *) (g :: * -> *) a (c :: * -> *).
(Typeable f, Typeable g, Typeable a, Data (f a), Data (g a)) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (These1 f g a)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (These1 f g a)
$ctoConstr :: forall (f :: * -> *) (g :: * -> *) a.
(Typeable f, Typeable g, Typeable a, Data (f a), Data (g a)) =>
These1 f g a -> Constr
toConstr :: These1 f g a -> Constr
$cdataTypeOf :: forall (f :: * -> *) (g :: * -> *) a.
(Typeable f, Typeable g, Typeable a, Data (f a), Data (g a)) =>
These1 f g a -> DataType
dataTypeOf :: These1 f g a -> DataType
$cdataCast1 :: forall (f :: * -> *) (g :: * -> *) a (t :: * -> *) (c :: * -> *).
(Typeable f, Typeable g, Typeable a, Data (f a), Data (g a),
 Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (These1 f g a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (These1 f g a))
$cdataCast2 :: forall (f :: * -> *) (g :: * -> *) a (t :: * -> * -> *)
       (c :: * -> *).
(Typeable f, Typeable g, Typeable a, Data (f a), Data (g a),
 Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (These1 f g a))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (These1 f g a))
$cgmapT :: forall (f :: * -> *) (g :: * -> *) a.
(Typeable f, Typeable g, Typeable a, Data (f a), Data (g a)) =>
(forall b. Data b => b -> b) -> These1 f g a -> These1 f g a
gmapT :: (forall b. Data b => b -> b) -> These1 f g a -> These1 f g a
$cgmapQl :: forall (f :: * -> *) (g :: * -> *) a r r'.
(Typeable f, Typeable g, Typeable a, Data (f a), Data (g a)) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> These1 f g a -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> These1 f g a -> r
$cgmapQr :: forall (f :: * -> *) (g :: * -> *) a r r'.
(Typeable f, Typeable g, Typeable a, Data (f a), Data (g a)) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> These1 f g a -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> These1 f g a -> r
$cgmapQ :: forall (f :: * -> *) (g :: * -> *) a u.
(Typeable f, Typeable g, Typeable a, Data (f a), Data (g a)) =>
(forall d. Data d => d -> u) -> These1 f g a -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> These1 f g a -> [u]
$cgmapQi :: forall (f :: * -> *) (g :: * -> *) a u.
(Typeable f, Typeable g, Typeable a, Data (f a), Data (g a)) =>
Int -> (forall d. Data d => d -> u) -> These1 f g a -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> These1 f g a -> u
$cgmapM :: forall (f :: * -> *) (g :: * -> *) a (m :: * -> *).
(Typeable f, Typeable g, Typeable a, Data (f a), Data (g a),
 Monad m) =>
(forall d. Data d => d -> m d) -> These1 f g a -> m (These1 f g a)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> These1 f g a -> m (These1 f g a)
$cgmapMp :: forall (f :: * -> *) (g :: * -> *) a (m :: * -> *).
(Typeable f, Typeable g, Typeable a, Data (f a), Data (g a),
 MonadPlus m) =>
(forall d. Data d => d -> m d) -> These1 f g a -> m (These1 f g a)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> These1 f g a -> m (These1 f g a)
$cgmapMo :: forall (f :: * -> *) (g :: * -> *) a (m :: * -> *).
(Typeable f, Typeable g, Typeable a, Data (f a), Data (g a),
 MonadPlus m) =>
(forall d. Data d => d -> m d) -> These1 f g a -> m (These1 f g a)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> These1 f g a -> m (These1 f g a)
Data)

-------------------------------------------------------------------------------
-- Eq1
-------------------------------------------------------------------------------

instance (Eq1 f, Eq1 g) => Eq1 (These1 f g) where
    liftEq :: forall a b.
(a -> b -> Bool) -> These1 f g a -> These1 f g b -> Bool
liftEq a -> b -> Bool
eq (This1 f a
f)    (This1 f b
f')     = (a -> b -> Bool) -> f a -> f b -> Bool
forall a b. (a -> b -> Bool) -> f a -> f b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq f a
f f b
f'
    liftEq a -> b -> Bool
eq (That1 g a
g)    (That1 g b
g')     = (a -> b -> Bool) -> g a -> g b -> Bool
forall a b. (a -> b -> Bool) -> g a -> g b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq g a
g g b
g'
    liftEq a -> b -> Bool
eq (These1 f a
f g a
g) (These1 f b
f' g b
g') = (a -> b -> Bool) -> f a -> f b -> Bool
forall a b. (a -> b -> Bool) -> f a -> f b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq f a
f f b
f' Bool -> Bool -> Bool
&& (a -> b -> Bool) -> g a -> g b -> Bool
forall a b. (a -> b -> Bool) -> g a -> g b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq g a
g g b
g'

    liftEq a -> b -> Bool
_ This1  {} These1 f g b
_ = Bool
False
    liftEq a -> b -> Bool
_ That1  {} These1 f g b
_ = Bool
False
    liftEq a -> b -> Bool
_ These1 {} These1 f g b
_ = Bool
False

-------------------------------------------------------------------------------
-- Ord1
-------------------------------------------------------------------------------

instance (Ord1 f, Ord1 g) => Ord1 (These1 f g) where
    liftCompare :: forall a b.
(a -> b -> Ordering) -> These1 f g a -> These1 f g b -> Ordering
liftCompare  a -> b -> Ordering
cmp (This1 f a
f) (This1 f b
f') = (a -> b -> Ordering) -> f a -> f b -> Ordering
forall a b. (a -> b -> Ordering) -> f a -> f b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
cmp f a
f f b
f'
    liftCompare a -> b -> Ordering
_cmp (This1 f a
_) These1 f g b
_          = Ordering
LT
    liftCompare a -> b -> Ordering
_cmp These1 f g a
_         (This1 f b
_)  = Ordering
GT

    liftCompare  a -> b -> Ordering
cmp (That1 g a
g) (That1 g b
g') = (a -> b -> Ordering) -> g a -> g b -> Ordering
forall a b. (a -> b -> Ordering) -> g a -> g b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
cmp g a
g g b
g'
    liftCompare a -> b -> Ordering
_cmp (That1 g a
_) These1 f g b
_          = Ordering
LT
    liftCompare a -> b -> Ordering
_cmp These1 f g a
_         (That1 g b
_)  = Ordering
GT

    liftCompare  a -> b -> Ordering
cmp (These1 f a
f g a
g) (These1 f b
f' g b
g') =
        (a -> b -> Ordering) -> f a -> f b -> Ordering
forall a b. (a -> b -> Ordering) -> f a -> f b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
cmp f a
f f b
f' Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend` (a -> b -> Ordering) -> g a -> g b -> Ordering
forall a b. (a -> b -> Ordering) -> g a -> g b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
cmp g a
g g b
g'

-------------------------------------------------------------------------------
-- Show1
-------------------------------------------------------------------------------

instance (Show1 f, Show1 g) => Show1 (These1 f g) where
    liftShowsPrec :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> These1 f g a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d (This1 f a
f) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10)
        (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"This1 "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
11 f a
f
    liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d (That1 g a
g) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10)
        (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"That1 "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> g a -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> g a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
11 g a
g
    liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d (These1 f a
f g a
g) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10)
        (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"These1 "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
11 f a
f
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> g a -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> g a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
11 g a
g

-------------------------------------------------------------------------------
-- Read1
-------------------------------------------------------------------------------

instance (Read1 f, Read1 g) => Read1 (These1 f g) where
    liftReadsPrec :: forall a.
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (These1 f g a)
liftReadsPrec Int -> ReadS a
rp ReadS [a]
rl Int
d = Bool -> ReadS (These1 f g a) -> ReadS (These1 f g a)
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ReadS (These1 f g a) -> ReadS (These1 f g a))
-> ReadS (These1 f g a) -> ReadS (These1 f g a)
forall a b. (a -> b) -> a -> b
$ \String
s0 -> do
        (String
t, String
s1) <- ReadS String
lex String
s0
        case String
t of
            String
"This1" -> do
                (f a
x, String
s2) <- (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
forall a. (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec Int -> ReadS a
rp ReadS [a]
rl Int
11 String
s1
                (These1 f g a, String) -> [(These1 f g a, String)]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (f a -> These1 f g a
forall (f :: * -> *) (g :: * -> *) a. f a -> These1 f g a
This1 f a
x, String
s2)
            String
"That1" -> do
                (g a
y, String
s2) <- (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (g a)
forall a. (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (g a)
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec Int -> ReadS a
rp ReadS [a]
rl Int
11 String
s1
                (These1 f g a, String) -> [(These1 f g a, String)]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (g a -> These1 f g a
forall (f :: * -> *) (g :: * -> *) a. g a -> These1 f g a
That1 g a
y, String
s2)
            String
"These1" -> do
                (f a
x, String
s2) <- (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
forall a. (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec Int -> ReadS a
rp ReadS [a]
rl Int
11 String
s1
                (g a
y, String
s3) <- (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (g a)
forall a. (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (g a)
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec Int -> ReadS a
rp ReadS [a]
rl Int
11 String
s2
                (These1 f g a, String) -> [(These1 f g a, String)]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (f a -> g a -> These1 f g a
forall (f :: * -> *) (g :: * -> *) a. f a -> g a -> These1 f g a
These1 f a
x g a
y, String
s3)
            String
_ -> []

-------------------------------------------------------------------------------
-- Eq, Ord, Show, Read
-------------------------------------------------------------------------------

instance (Eq   (f a), Eq   (g a), Eq a)   => Eq (These1 f g a) where
    This1 f a
f    == :: These1 f g a -> These1 f g a -> Bool
== This1 f a
f'     = f a
f f a -> f a -> Bool
forall a. Eq a => a -> a -> Bool
== f a
f'
    That1 g a
g    == That1 g a
g'     = g a
g g a -> g a -> Bool
forall a. Eq a => a -> a -> Bool
== g a
g'
    These1 f a
f g a
g == These1 f a
f' g a
g' = f a
f f a -> f a -> Bool
forall a. Eq a => a -> a -> Bool
== f a
f' Bool -> Bool -> Bool
&& g a
g g a -> g a -> Bool
forall a. Eq a => a -> a -> Bool
== g a
g'

    This1  {} == These1 f g a
_ = Bool
False
    That1  {} == These1 f g a
_ = Bool
False
    These1 {} == These1 f g a
_ = Bool
False

instance (Ord  (f a), Ord  (g a), Ord a)  => Ord (These1 f g a) where
    compare :: These1 f g a -> These1 f g a -> Ordering
compare (This1 f a
f) (This1 f a
f') = f a -> f a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare f a
f f a
f'
    compare (This1 f a
_) These1 f g a
_          = Ordering
LT
    compare These1 f g a
_         (This1 f a
_)  = Ordering
GT

    compare (That1 g a
g) (That1 g a
g') = g a -> g a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare g a
g g a
g'
    compare (That1 g a
_) These1 f g a
_          = Ordering
LT
    compare These1 f g a
_         (That1 g a
_)  = Ordering
GT

    compare  (These1 f a
f g a
g) (These1 f a
f' g a
g') =
        f a -> f a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare f a
f f a
f' Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend` g a -> g a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare g a
g g a
g'

instance (Show (f a), Show (g a), Show a) => Show (These1 f g a) where
    showsPrec :: Int -> These1 f g a -> ShowS
showsPrec Int
d (This1 f a
f) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10)
        (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"This1 "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> f a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 f a
f
    showsPrec Int
d (That1 g a
g) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10)
        (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"That1 "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> g a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 g a
g
    showsPrec Int
d (These1 f a
f g a
g) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10)
        (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"These1 "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> f a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 f a
f
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> g a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 g a
g

instance (Read (f a), Read (g a), Read a) => Read (These1 f g a) where
    readsPrec :: Int -> ReadS (These1 f g a)
readsPrec Int
d = Bool -> ReadS (These1 f g a) -> ReadS (These1 f g a)
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ReadS (These1 f g a) -> ReadS (These1 f g a))
-> ReadS (These1 f g a) -> ReadS (These1 f g a)
forall a b. (a -> b) -> a -> b
$ \String
s0 -> do
        (String
t, String
s1) <- ReadS String
lex String
s0
        case String
t of
            String
"This1" -> do
                (f a
x, String
s2) <- Int -> ReadS (f a)
forall a. Read a => Int -> ReadS a
readsPrec Int
11 String
s1
                (These1 f g a, String) -> [(These1 f g a, String)]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (f a -> These1 f g a
forall (f :: * -> *) (g :: * -> *) a. f a -> These1 f g a
This1 f a
x, String
s2)
            String
"That1" -> do
                (g a
y, String
s2) <- Int -> ReadS (g a)
forall a. Read a => Int -> ReadS a
readsPrec Int
11 String
s1
                (These1 f g a, String) -> [(These1 f g a, String)]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (g a -> These1 f g a
forall (f :: * -> *) (g :: * -> *) a. g a -> These1 f g a
That1 g a
y, String
s2)
            String
"These1" -> do
                (f a
x, String
s2) <- Int -> ReadS (f a)
forall a. Read a => Int -> ReadS a
readsPrec Int
11 String
s1
                (g a
y, String
s3) <- Int -> ReadS (g a)
forall a. Read a => Int -> ReadS a
readsPrec Int
11 String
s2
                (These1 f g a, String) -> [(These1 f g a, String)]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (f a -> g a -> These1 f g a
forall (f :: * -> *) (g :: * -> *) a. f a -> g a -> These1 f g a
These1 f a
x g a
y, String
s3)
            String
_ -> []

-------------------------------------------------------------------------------
-- deepseq
-------------------------------------------------------------------------------

-- | This instance is available only with @deepseq >= 1.4.3.0@
instance (NFData1 f, NFData1 g) => NFData1 (These1 f g) where
    liftRnf :: forall a. (a -> ()) -> These1 f g a -> ()
liftRnf a -> ()
r (This1 f a
x)    = (a -> ()) -> f a -> ()
forall a. (a -> ()) -> f a -> ()
forall (f :: * -> *) a. NFData1 f => (a -> ()) -> f a -> ()
liftRnf a -> ()
r f a
x
    liftRnf a -> ()
r (That1 g a
y)    = (a -> ()) -> g a -> ()
forall a. (a -> ()) -> g a -> ()
forall (f :: * -> *) a. NFData1 f => (a -> ()) -> f a -> ()
liftRnf a -> ()
r g a
y
    liftRnf a -> ()
r (These1 f a
x g a
y) = (a -> ()) -> f a -> ()
forall a. (a -> ()) -> f a -> ()
forall (f :: * -> *) a. NFData1 f => (a -> ()) -> f a -> ()
liftRnf a -> ()
r f a
x () -> () -> ()
forall a b. a -> b -> b
`seq` (a -> ()) -> g a -> ()
forall a. (a -> ()) -> g a -> ()
forall (f :: * -> *) a. NFData1 f => (a -> ()) -> f a -> ()
liftRnf a -> ()
r g a
y

-- | Available always
--
-- @since 1.2
instance (NFData (f a), NFData (g a), NFData a) => NFData (These1 f g a) where
    rnf :: These1 f g a -> ()
rnf (This1 f a
x)    = f a -> ()
forall a. NFData a => a -> ()
rnf f a
x
    rnf (That1 g a
y)    = g a -> ()
forall a. NFData a => a -> ()
rnf g a
y
    rnf (These1 f a
x g a
y) = f a -> ()
forall a. NFData a => a -> ()
rnf f a
x () -> () -> ()
forall a b. a -> b -> b
`seq` g a -> ()
forall a. NFData a => a -> ()
rnf g a
y

-------------------------------------------------------------------------------
-- foldable1
-------------------------------------------------------------------------------

-- | @since 1.2
instance (F1.Foldable1 f, F1.Foldable1 g) => F1.Foldable1 (These1 f g) where
    foldMap1 :: forall m a. Semigroup m => (a -> m) -> These1 f g a -> m
foldMap1 a -> m
f (This1 f a
x)    = (a -> m) -> f a -> m
forall m a. Semigroup m => (a -> m) -> f a -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
F1.foldMap1 a -> m
f f a
x
    foldMap1 a -> m
f (That1 g a
y)    = (a -> m) -> g a -> m
forall m a. Semigroup m => (a -> m) -> g a -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
F1.foldMap1 a -> m
f g a
y
    foldMap1 a -> m
f (These1 f a
x g a
y) = (a -> m) -> f a -> m
forall m a. Semigroup m => (a -> m) -> f a -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
F1.foldMap1 a -> m
f f a
x m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (a -> m) -> g a -> m
forall m a. Semigroup m => (a -> m) -> g a -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
F1.foldMap1 a -> m
f g a
y

    foldrMap1 :: forall a b. (a -> b) -> (a -> b -> b) -> These1 f g a -> b
foldrMap1 a -> b
f a -> b -> b
g (This1 f a
x)    = (a -> b) -> (a -> b -> b) -> f a -> b
forall a b. (a -> b) -> (a -> b -> b) -> f a -> b
forall (t :: * -> *) a b.
Foldable1 t =>
(a -> b) -> (a -> b -> b) -> t a -> b
F1.foldrMap1 a -> b
f a -> b -> b
g f a
x
    foldrMap1 a -> b
f a -> b -> b
g (That1 g a
y)    = (a -> b) -> (a -> b -> b) -> g a -> b
forall a b. (a -> b) -> (a -> b -> b) -> g a -> b
forall (t :: * -> *) a b.
Foldable1 t =>
(a -> b) -> (a -> b -> b) -> t a -> b
F1.foldrMap1 a -> b
f a -> b -> b
g g a
y
    foldrMap1 a -> b
f a -> b -> b
g (These1 f a
x g a
y) = (a -> b -> b) -> b -> f a -> b
forall a b. (a -> b -> b) -> b -> f a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr a -> b -> b
g ((a -> b) -> (a -> b -> b) -> g a -> b
forall a b. (a -> b) -> (a -> b -> b) -> g a -> b
forall (t :: * -> *) a b.
Foldable1 t =>
(a -> b) -> (a -> b -> b) -> t a -> b
F1.foldrMap1 a -> b
f a -> b -> b
g g a
y) f a
x

    head :: forall a. These1 f g a -> a
head (This1 f a
x)    = f a -> a
forall a. f a -> a
forall (t :: * -> *) a. Foldable1 t => t a -> a
F1.head f a
x
    head (That1 g a
y)    = g a -> a
forall a. g a -> a
forall (t :: * -> *) a. Foldable1 t => t a -> a
F1.head g a
y
    head (These1 f a
x g a
_) = f a -> a
forall a. f a -> a
forall (t :: * -> *) a. Foldable1 t => t a -> a
F1.head f a
x

    last :: forall a. These1 f g a -> a
last (This1 f a
x)    = f a -> a
forall a. f a -> a
forall (t :: * -> *) a. Foldable1 t => t a -> a
F1.last f a
x
    last (That1 g a
y)    = g a -> a
forall a. g a -> a
forall (t :: * -> *) a. Foldable1 t => t a -> a
F1.last g a
y
    last (These1 f a
_ g a
y) = g a -> a
forall a. g a -> a
forall (t :: * -> *) a. Foldable1 t => t a -> a
F1.last g a
y