{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Control.Lens.Internal.Getter
( noEffect
, AlongsideLeft(..)
, AlongsideRight(..)
) where
import Prelude ()
import Control.Lens.Internal.Prelude
import Data.Bifoldable
import Data.Bifunctor
import Data.Bitraversable
import Data.Semigroup.Foldable
import Data.Semigroup.Traversable
noEffect :: (Contravariant f, Applicative f) => f a
noEffect :: forall (f :: * -> *) a. (Contravariant f, Applicative f) => f a
noEffect = forall (f :: * -> *) a b.
(Functor f, Contravariant f) =>
f a -> f b
phantom forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
{-# INLINE noEffect #-}
newtype AlongsideLeft f b a = AlongsideLeft { forall (f :: * -> *) b a. AlongsideLeft f b a -> f (a, b)
getAlongsideLeft :: f (a, b) }
deriving instance Show (f (a, b)) => Show (AlongsideLeft f b a)
deriving instance Read (f (a, b)) => Read (AlongsideLeft f b a)
instance Functor f => Functor (AlongsideLeft f b) where
fmap :: forall a b. (a -> b) -> AlongsideLeft f b a -> AlongsideLeft f b b
fmap a -> b
f = forall (f :: * -> *) b a. f (a, b) -> AlongsideLeft f b a
AlongsideLeft forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first a -> b
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) b a. AlongsideLeft f b a -> f (a, b)
getAlongsideLeft
{-# INLINE fmap #-}
instance Contravariant f => Contravariant (AlongsideLeft f b) where
contramap :: forall a' a.
(a' -> a) -> AlongsideLeft f b a -> AlongsideLeft f b a'
contramap a' -> a
f = forall (f :: * -> *) b a. f (a, b) -> AlongsideLeft f b a
AlongsideLeft forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first a' -> a
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) b a. AlongsideLeft f b a -> f (a, b)
getAlongsideLeft
{-# INLINE contramap #-}
instance Foldable f => Foldable (AlongsideLeft f b) where
foldMap :: forall m a. Monoid m => (a -> m) -> AlongsideLeft f b a -> m
foldMap a -> m
f = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (a -> m
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) b a. AlongsideLeft f b a -> f (a, b)
getAlongsideLeft
{-# INLINE foldMap #-}
instance Traversable f => Traversable (AlongsideLeft f b) where
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> AlongsideLeft f b a -> f (AlongsideLeft f b b)
traverse a -> f b
f (AlongsideLeft f (a, b)
as) = forall (f :: * -> *) b a. f (a, b) -> AlongsideLeft f b a
AlongsideLeft 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 (forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f b
f forall (f :: * -> *) a. Applicative f => a -> f a
pure) f (a, b)
as
{-# INLINE traverse #-}
instance Foldable1 f => Foldable1 (AlongsideLeft f b) where
foldMap1 :: forall m a. Semigroup m => (a -> m) -> AlongsideLeft f b a -> m
foldMap1 a -> m
f = forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 (a -> m
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) b a. AlongsideLeft f b a -> f (a, b)
getAlongsideLeft
{-# INLINE foldMap1 #-}
instance Traversable1 f => Traversable1 (AlongsideLeft f b) where
traverse1 :: forall (f :: * -> *) a b.
Apply f =>
(a -> f b) -> AlongsideLeft f b a -> f (AlongsideLeft f b b)
traverse1 a -> f b
f (AlongsideLeft f (a, b)
as) = forall (f :: * -> *) b a. f (a, b) -> AlongsideLeft f b a
AlongsideLeft forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable1 t, Apply f) =>
(a -> f b) -> t a -> f (t b)
traverse1 (\(a
a,b
b) -> forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) b
b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a) f (a, b)
as
{-# INLINE traverse1 #-}
instance Functor f => Bifunctor (AlongsideLeft f) where
bimap :: forall a b c d.
(a -> b) -> (c -> d) -> AlongsideLeft f a c -> AlongsideLeft f b d
bimap a -> b
f c -> d
g = forall (f :: * -> *) b a. f (a, b) -> AlongsideLeft f b a
AlongsideLeft forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap c -> d
g a -> b
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) b a. AlongsideLeft f b a -> f (a, b)
getAlongsideLeft
{-# INLINE bimap #-}
instance Foldable f => Bifoldable (AlongsideLeft f) where
bifoldMap :: forall m a b.
Monoid m =>
(a -> m) -> (b -> m) -> AlongsideLeft f a b -> m
bifoldMap a -> m
f b -> m
g = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap b -> m
g a -> m
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) b a. AlongsideLeft f b a -> f (a, b)
getAlongsideLeft
{-# INLINE bifoldMap #-}
instance Traversable f => Bitraversable (AlongsideLeft f) where
bitraverse :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c)
-> (b -> f d) -> AlongsideLeft f a b -> f (AlongsideLeft f c d)
bitraverse a -> f c
f b -> f d
g (AlongsideLeft f (b, a)
as) = forall (f :: * -> *) b a. f (a, b) -> AlongsideLeft f b a
AlongsideLeft 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 (forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse b -> f d
g a -> f c
f) f (b, a)
as
{-# INLINE bitraverse #-}
newtype AlongsideRight f a b = AlongsideRight { forall (f :: * -> *) a b. AlongsideRight f a b -> f (a, b)
getAlongsideRight :: f (a, b) }
deriving instance Show (f (a, b)) => Show (AlongsideRight f a b)
deriving instance Read (f (a, b)) => Read (AlongsideRight f a b)
instance Functor f => Functor (AlongsideRight f a) where
fmap :: forall a b.
(a -> b) -> AlongsideRight f a a -> AlongsideRight f a b
fmap a -> b
f (AlongsideRight f (a, a)
x) = forall (f :: * -> *) a b. f (a, b) -> AlongsideRight f a b
AlongsideRight (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second a -> b
f) f (a, a)
x)
{-# INLINE fmap #-}
instance Contravariant f => Contravariant (AlongsideRight f a) where
contramap :: forall a' a.
(a' -> a) -> AlongsideRight f a a -> AlongsideRight f a a'
contramap a' -> a
f (AlongsideRight f (a, a)
x) = forall (f :: * -> *) a b. f (a, b) -> AlongsideRight f a b
AlongsideRight (forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second a' -> a
f) f (a, a)
x)
{-# INLINE contramap #-}
instance Foldable f => Foldable (AlongsideRight f a) where
foldMap :: forall m a. Monoid m => (a -> m) -> AlongsideRight f a a -> m
foldMap a -> m
f = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (a -> m
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. AlongsideRight f a b -> f (a, b)
getAlongsideRight
{-# INLINE foldMap #-}
instance Traversable f => Traversable (AlongsideRight f a) where
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> AlongsideRight f a a -> f (AlongsideRight f a b)
traverse a -> f b
f (AlongsideRight f (a, a)
as) = forall (f :: * -> *) a b. f (a, b) -> AlongsideRight f a b
AlongsideRight 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 (forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse forall (f :: * -> *) a. Applicative f => a -> f a
pure a -> f b
f) f (a, a)
as
{-# INLINE traverse #-}
instance Foldable1 f => Foldable1 (AlongsideRight f a) where
foldMap1 :: forall m a. Semigroup m => (a -> m) -> AlongsideRight f a a -> m
foldMap1 a -> m
f = forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 (a -> m
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. AlongsideRight f a b -> f (a, b)
getAlongsideRight
{-# INLINE foldMap1 #-}
instance Traversable1 f => Traversable1 (AlongsideRight f a) where
traverse1 :: forall (f :: * -> *) a b.
Apply f =>
(a -> f b) -> AlongsideRight f a a -> f (AlongsideRight f a b)
traverse1 a -> f b
f (AlongsideRight f (a, a)
as) = forall (f :: * -> *) a b. f (a, b) -> AlongsideRight f a b
AlongsideRight forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable1 t, Apply f) =>
(a -> f b) -> t a -> f (t b)
traverse1 (\(a
a,a
b) -> (,) a
a forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
b) f (a, a)
as
{-# INLINE traverse1 #-}
instance Functor f => Bifunctor (AlongsideRight f) where
bimap :: forall a b c d.
(a -> b)
-> (c -> d) -> AlongsideRight f a c -> AlongsideRight f b d
bimap a -> b
f c -> d
g = forall (f :: * -> *) a b. f (a, b) -> AlongsideRight f a b
AlongsideRight forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
f c -> d
g) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. AlongsideRight f a b -> f (a, b)
getAlongsideRight
{-# INLINE bimap #-}
instance Foldable f => Bifoldable (AlongsideRight f) where
bifoldMap :: forall m a b.
Monoid m =>
(a -> m) -> (b -> m) -> AlongsideRight f a b -> m
bifoldMap a -> m
f b -> m
g = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap a -> m
f b -> m
g) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. AlongsideRight f a b -> f (a, b)
getAlongsideRight
{-# INLINE bifoldMap #-}
instance Traversable f => Bitraversable (AlongsideRight f) where
bitraverse :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c)
-> (b -> f d) -> AlongsideRight f a b -> f (AlongsideRight f c d)
bitraverse a -> f c
f b -> f d
g (AlongsideRight f (a, b)
as) = forall (f :: * -> *) a b. f (a, b) -> AlongsideRight f a b
AlongsideRight 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 (forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f c
f b -> f d
g) f (a, b)
as
{-# INLINE bitraverse #-}