{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Lens.Internal.Getter
-- Copyright   :  (C) 2012-2016 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  provisional
-- Portability :  non-portable
--
----------------------------------------------------------------------------
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

-- | The 'mempty' equivalent for a 'Contravariant' 'Applicative' 'Functor'.
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 #-}