{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE Safe #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Functor.Sum
-- Copyright   :  (c) Ross Paterson 2014
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  libraries@haskell.org
-- Stability   :  experimental
-- Portability :  portable
--
-- Sums, lifted to functors.
--
-- @since 4.9.0.0
-----------------------------------------------------------------------------

module Data.Functor.Sum (
    Sum(..),
  ) where

import Control.Applicative ((<|>))
import Data.Data (Data)
import Data.Functor.Classes
import GHC.Generics (Generic, Generic1)
import Text.Read (Read(..), readListDefault, readListPrecDefault)

-- | Lifted sum of functors.
data Sum f g a = InL (f a) | InR (g a)
  deriving ( Sum f g a -> Constr
Sum f g a -> DataType
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 {k} {f :: k -> *} {g :: k -> *} {a :: k}.
(Typeable a, Typeable f, Typeable g, Typeable k, Data (f a),
 Data (g a)) =>
Typeable (Sum f g a)
forall k (f :: k -> *) (g :: k -> *) (a :: k).
(Typeable a, Typeable f, Typeable g, Typeable k, Data (f a),
 Data (g a)) =>
Sum f g a -> Constr
forall k (f :: k -> *) (g :: k -> *) (a :: k).
(Typeable a, Typeable f, Typeable g, Typeable k, Data (f a),
 Data (g a)) =>
Sum f g a -> DataType
forall k (f :: k -> *) (g :: k -> *) (a :: k).
(Typeable a, Typeable f, Typeable g, Typeable k, Data (f a),
 Data (g a)) =>
(forall b. Data b => b -> b) -> Sum f g a -> Sum f g a
forall k (f :: k -> *) (g :: k -> *) (a :: k) u.
(Typeable a, Typeable f, Typeable g, Typeable k, Data (f a),
 Data (g a)) =>
Int -> (forall d. Data d => d -> u) -> Sum f g a -> u
forall k (f :: k -> *) (g :: k -> *) (a :: k) u.
(Typeable a, Typeable f, Typeable g, Typeable k, Data (f a),
 Data (g a)) =>
(forall d. Data d => d -> u) -> Sum f g a -> [u]
forall k (f :: k -> *) (g :: k -> *) (a :: k) r r'.
(Typeable a, Typeable f, Typeable g, Typeable k, Data (f a),
 Data (g a)) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Sum f g a -> r
forall k (f :: k -> *) (g :: k -> *) (a :: k) r r'.
(Typeable a, Typeable f, Typeable g, Typeable k, Data (f a),
 Data (g a)) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Sum f g a -> r
forall k (f :: k -> *) (g :: k -> *) (a :: k) (m :: * -> *).
(Typeable a, Typeable f, Typeable g, Typeable k, Data (f a),
 Data (g a), Monad m) =>
(forall d. Data d => d -> m d) -> Sum f g a -> m (Sum f g a)
forall k (f :: k -> *) (g :: k -> *) (a :: k) (m :: * -> *).
(Typeable a, Typeable f, Typeable g, Typeable k, Data (f a),
 Data (g a), MonadPlus m) =>
(forall d. Data d => d -> m d) -> Sum f g a -> m (Sum f g a)
forall k (f :: k -> *) (g :: k -> *) (a :: k) (c :: * -> *).
(Typeable a, Typeable f, Typeable g, Typeable k, Data (f a),
 Data (g a)) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Sum f g a)
forall k (f :: k -> *) (g :: k -> *) (a :: k) (c :: * -> *).
(Typeable a, Typeable f, Typeable g, Typeable k, Data (f a),
 Data (g a)) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Sum f g a -> c (Sum f g a)
forall k (f :: k -> *) (g :: k -> *) (a :: k) (t :: * -> *)
       (c :: * -> *).
(Typeable a, Typeable f, Typeable g, Typeable k, Data (f a),
 Data (g a), Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Sum f g a))
forall k (f :: k -> *) (g :: k -> *) (a :: k) (t :: * -> * -> *)
       (c :: * -> *).
(Typeable a, Typeable f, Typeable g, Typeable k, Data (f a),
 Data (g a), Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Sum f g a))
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Sum f g a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Sum f g a -> c (Sum f g a)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Sum f g a -> m (Sum f g a)
$cgmapMo :: forall k (f :: k -> *) (g :: k -> *) (a :: k) (m :: * -> *).
(Typeable a, Typeable f, Typeable g, Typeable k, Data (f a),
 Data (g a), MonadPlus m) =>
(forall d. Data d => d -> m d) -> Sum f g a -> m (Sum f g a)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Sum f g a -> m (Sum f g a)
$cgmapMp :: forall k (f :: k -> *) (g :: k -> *) (a :: k) (m :: * -> *).
(Typeable a, Typeable f, Typeable g, Typeable k, Data (f a),
 Data (g a), MonadPlus m) =>
(forall d. Data d => d -> m d) -> Sum f g a -> m (Sum f g a)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Sum f g a -> m (Sum f g a)
$cgmapM :: forall k (f :: k -> *) (g :: k -> *) (a :: k) (m :: * -> *).
(Typeable a, Typeable f, Typeable g, Typeable k, Data (f a),
 Data (g a), Monad m) =>
(forall d. Data d => d -> m d) -> Sum f g a -> m (Sum f g a)
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Sum f g a -> u
$cgmapQi :: forall k (f :: k -> *) (g :: k -> *) (a :: k) u.
(Typeable a, Typeable f, Typeable g, Typeable k, Data (f a),
 Data (g a)) =>
Int -> (forall d. Data d => d -> u) -> Sum f g a -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Sum f g a -> [u]
$cgmapQ :: forall k (f :: k -> *) (g :: k -> *) (a :: k) u.
(Typeable a, Typeable f, Typeable g, Typeable k, Data (f a),
 Data (g a)) =>
(forall d. Data d => d -> u) -> Sum f g a -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Sum f g a -> r
$cgmapQr :: forall k (f :: k -> *) (g :: k -> *) (a :: k) r r'.
(Typeable a, Typeable f, Typeable g, Typeable k, Data (f a),
 Data (g a)) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Sum f g a -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Sum f g a -> r
$cgmapQl :: forall k (f :: k -> *) (g :: k -> *) (a :: k) r r'.
(Typeable a, Typeable f, Typeable g, Typeable k, Data (f a),
 Data (g a)) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Sum f g a -> r
gmapT :: (forall b. Data b => b -> b) -> Sum f g a -> Sum f g a
$cgmapT :: forall k (f :: k -> *) (g :: k -> *) (a :: k).
(Typeable a, Typeable f, Typeable g, Typeable k, Data (f a),
 Data (g a)) =>
(forall b. Data b => b -> b) -> Sum f g a -> Sum f g a
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Sum f g a))
$cdataCast2 :: forall k (f :: k -> *) (g :: k -> *) (a :: k) (t :: * -> * -> *)
       (c :: * -> *).
(Typeable a, Typeable f, Typeable g, Typeable k, Data (f a),
 Data (g a), Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Sum f g a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Sum f g a))
$cdataCast1 :: forall k (f :: k -> *) (g :: k -> *) (a :: k) (t :: * -> *)
       (c :: * -> *).
(Typeable a, Typeable f, Typeable g, Typeable k, Data (f a),
 Data (g a), Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Sum f g a))
dataTypeOf :: Sum f g a -> DataType
$cdataTypeOf :: forall k (f :: k -> *) (g :: k -> *) (a :: k).
(Typeable a, Typeable f, Typeable g, Typeable k, Data (f a),
 Data (g a)) =>
Sum f g a -> DataType
toConstr :: Sum f g a -> Constr
$ctoConstr :: forall k (f :: k -> *) (g :: k -> *) (a :: k).
(Typeable a, Typeable f, Typeable g, Typeable k, Data (f a),
 Data (g a)) =>
Sum f g a -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Sum f g a)
$cgunfold :: forall k (f :: k -> *) (g :: k -> *) (a :: k) (c :: * -> *).
(Typeable a, Typeable f, Typeable g, Typeable k, Data (f a),
 Data (g a)) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Sum f g a)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Sum f g a -> c (Sum f g a)
$cgfoldl :: forall k (f :: k -> *) (g :: k -> *) (a :: k) (c :: * -> *).
(Typeable a, Typeable f, Typeable g, Typeable k, Data (f a),
 Data (g a)) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Sum f g a -> c (Sum f g a)
Data     -- ^ @since 4.9.0.0
           , forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k (f :: k -> *) (g :: k -> *) (a :: k) x.
Rep (Sum f g a) x -> Sum f g a
forall k (f :: k -> *) (g :: k -> *) (a :: k) x.
Sum f g a -> Rep (Sum f g a) x
$cto :: forall k (f :: k -> *) (g :: k -> *) (a :: k) x.
Rep (Sum f g a) x -> Sum f g a
$cfrom :: forall k (f :: k -> *) (g :: k -> *) (a :: k) x.
Sum f g a -> Rep (Sum f g a) x
Generic  -- ^ @since 4.9.0.0
           , forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
forall k (f :: k -> *) (g :: k -> *) (a :: k).
Rep1 (Sum f g) a -> Sum f g a
forall k (f :: k -> *) (g :: k -> *) (a :: k).
Sum f g a -> Rep1 (Sum f g) a
$cto1 :: forall k (f :: k -> *) (g :: k -> *) (a :: k).
Rep1 (Sum f g) a -> Sum f g a
$cfrom1 :: forall k (f :: k -> *) (g :: k -> *) (a :: k).
Sum f g a -> Rep1 (Sum f g) a
Generic1 -- ^ @since 4.9.0.0
           )

-- | @since 4.9.0.0
instance (Eq1 f, Eq1 g) => Eq1 (Sum f g) where
    liftEq :: forall a b. (a -> b -> Bool) -> Sum f g a -> Sum f g b -> Bool
liftEq a -> b -> Bool
eq (InL f a
x1) (InL f b
x2) = forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq f a
x1 f b
x2
    liftEq a -> b -> Bool
_ (InL f a
_) (InR g b
_) = Bool
False
    liftEq a -> b -> Bool
_ (InR g a
_) (InL f b
_) = Bool
False
    liftEq a -> b -> Bool
eq (InR g a
y1) (InR g b
y2) = forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq g a
y1 g b
y2

-- | @since 4.9.0.0
instance (Ord1 f, Ord1 g) => Ord1 (Sum f g) where
    liftCompare :: forall a b.
(a -> b -> Ordering) -> Sum f g a -> Sum f g b -> Ordering
liftCompare a -> b -> Ordering
comp (InL f a
x1) (InL f b
x2) = forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
comp f a
x1 f b
x2
    liftCompare a -> b -> Ordering
_ (InL f a
_) (InR g b
_) = Ordering
LT
    liftCompare a -> b -> Ordering
_ (InR g a
_) (InL f b
_) = Ordering
GT
    liftCompare a -> b -> Ordering
comp (InR g a
y1) (InR g b
y2) = forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
comp g a
y1 g b
y2

-- | @since 4.9.0.0
instance (Read1 f, Read1 g) => Read1 (Sum f g) where
    liftReadPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (Sum f g a)
liftReadPrec ReadPrec a
rp ReadPrec [a]
rl = forall a. ReadPrec a -> ReadPrec a
readData forall a b. (a -> b) -> a -> b
$
        forall a t. ReadPrec a -> String -> (a -> t) -> ReadPrec t
readUnaryWith (forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
liftReadPrec ReadPrec a
rp ReadPrec [a]
rl) String
"InL" forall {k} (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
InL forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
        forall a t. ReadPrec a -> String -> (a -> t) -> ReadPrec t
readUnaryWith (forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec (f a)
liftReadPrec ReadPrec a
rp ReadPrec [a]
rl) String
"InR" forall {k} (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
InR

    liftReadListPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec [Sum f g a]
liftReadListPrec = forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec [f a]
liftReadListPrecDefault
    liftReadList :: forall a. (Int -> ReadS a) -> ReadS [a] -> ReadS [Sum f g a]
liftReadList     = forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [f a]
liftReadListDefault

-- | @since 4.9.0.0
instance (Show1 f, Show1 g) => Show1 (Sum f g) where
    liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Sum f g a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d (InL f a
x) =
        forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith (forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl) String
"InL" Int
d f a
x
    liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d (InR g a
y) =
        forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith (forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl) String
"InR" Int
d g a
y

-- | @since 4.9.0.0
instance (Eq1 f, Eq1 g, Eq a) => Eq (Sum f g a) where
    == :: Sum f g a -> Sum f g a -> Bool
(==) = forall (f :: * -> *) a. (Eq1 f, Eq a) => f a -> f a -> Bool
eq1
-- | @since 4.9.0.0
instance (Ord1 f, Ord1 g, Ord a) => Ord (Sum f g a) where
    compare :: Sum f g a -> Sum f g a -> Ordering
compare = forall (f :: * -> *) a. (Ord1 f, Ord a) => f a -> f a -> Ordering
compare1
-- | @since 4.9.0.0
instance (Read1 f, Read1 g, Read a) => Read (Sum f g a) where
    readPrec :: ReadPrec (Sum f g a)
readPrec = forall (f :: * -> *) a. (Read1 f, Read a) => ReadPrec (f a)
readPrec1

    readListPrec :: ReadPrec [Sum f g a]
readListPrec = forall a. Read a => ReadPrec [a]
readListPrecDefault
    readList :: ReadS [Sum f g a]
readList     = forall a. Read a => ReadS [a]
readListDefault
-- | @since 4.9.0.0
instance (Show1 f, Show1 g, Show a) => Show (Sum f g a) where
    showsPrec :: Int -> Sum f g a -> ShowS
showsPrec = forall (f :: * -> *) a. (Show1 f, Show a) => Int -> f a -> ShowS
showsPrec1

-- | @since 4.9.0.0
instance (Functor f, Functor g) => Functor (Sum f g) where
    fmap :: forall a b. (a -> b) -> Sum f g a -> Sum f g b
fmap a -> b
f (InL f a
x) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
InL (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f f a
x)
    fmap a -> b
f (InR g a
y) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
InR (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f g a
y)

    a
a <$ :: forall a b. a -> Sum f g b -> Sum f g a
<$ (InL f b
x) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
InL (a
a forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f b
x)
    a
a <$ (InR g b
y) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
InR (a
a forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ g b
y)

-- | @since 4.9.0.0
instance (Foldable f, Foldable g) => Foldable (Sum f g) where
    foldMap :: forall m a. Monoid m => (a -> m) -> Sum f g a -> m
foldMap a -> m
f (InL f a
x) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f f a
x
    foldMap a -> m
f (InR g a
y) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f g a
y

-- | @since 4.9.0.0
instance (Traversable f, Traversable g) => Traversable (Sum f g) where
    traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Sum f g a -> f (Sum f g b)
traverse a -> f b
f (InL f a
x) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
InL forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f f a
x
    traverse a -> f b
f (InR g a
y) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
InR forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f g a
y