{-# 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 :: f a
noEffect = f () -> f a
forall (f :: * -> *) a b.
(Functor f, Contravariant f) =>
f a -> f b
phantom (f () -> f a) -> f () -> f a
forall a b. (a -> b) -> a -> b
$ () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
{-# INLINE noEffect #-}

newtype AlongsideLeft f b a = AlongsideLeft { 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 :: (a -> b) -> AlongsideLeft f b a -> AlongsideLeft f b b
fmap a -> b
f = f (b, b) -> AlongsideLeft f b b
forall (f :: * -> *) b a. f (a, b) -> AlongsideLeft f b a
AlongsideLeft (f (b, b) -> AlongsideLeft f b b)
-> (AlongsideLeft f b a -> f (b, b))
-> AlongsideLeft f b a
-> AlongsideLeft f b b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b) -> (b, b)) -> f (a, b) -> f (b, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> (a, b) -> (b, b)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first a -> b
f) (f (a, b) -> f (b, b))
-> (AlongsideLeft f b a -> f (a, b))
-> AlongsideLeft f b a
-> f (b, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlongsideLeft f b a -> f (a, b)
forall (f :: * -> *) b a. AlongsideLeft f b a -> f (a, b)
getAlongsideLeft
  {-# INLINE fmap #-}

instance Contravariant f => Contravariant (AlongsideLeft f b) where
  contramap :: (a -> b) -> AlongsideLeft f b b -> AlongsideLeft f b a
contramap a -> b
f = f (a, b) -> AlongsideLeft f b a
forall (f :: * -> *) b a. f (a, b) -> AlongsideLeft f b a
AlongsideLeft (f (a, b) -> AlongsideLeft f b a)
-> (AlongsideLeft f b b -> f (a, b))
-> AlongsideLeft f b b
-> AlongsideLeft f b a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b) -> (b, b)) -> f (b, b) -> f (a, b)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap ((a -> b) -> (a, b) -> (b, b)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first a -> b
f) (f (b, b) -> f (a, b))
-> (AlongsideLeft f b b -> f (b, b))
-> AlongsideLeft f b b
-> f (a, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlongsideLeft f b b -> f (b, b)
forall (f :: * -> *) b a. AlongsideLeft f b a -> f (a, b)
getAlongsideLeft
  {-# INLINE contramap #-}

instance Foldable f => Foldable (AlongsideLeft f b) where
  foldMap :: (a -> m) -> AlongsideLeft f b a -> m
foldMap a -> m
f = ((a, b) -> m) -> f (a, b) -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (a -> m
f (a -> m) -> ((a, b) -> a) -> (a, b) -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b) -> a
forall a b. (a, b) -> a
fst) (f (a, b) -> m)
-> (AlongsideLeft f b a -> f (a, b)) -> AlongsideLeft f b a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlongsideLeft f b a -> f (a, b)
forall (f :: * -> *) b a. AlongsideLeft f b a -> f (a, b)
getAlongsideLeft
  {-# INLINE foldMap #-}

instance Traversable f => Traversable (AlongsideLeft f b) where
  traverse :: (a -> f b) -> AlongsideLeft f b a -> f (AlongsideLeft f b b)
traverse a -> f b
f (AlongsideLeft f (a, b)
as) = f (b, b) -> AlongsideLeft f b b
forall (f :: * -> *) b a. f (a, b) -> AlongsideLeft f b a
AlongsideLeft (f (b, b) -> AlongsideLeft f b b)
-> f (f (b, b)) -> f (AlongsideLeft f b b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((a, b) -> f (b, b)) -> f (a, b) -> f (f (b, b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((a -> f b) -> (b -> f b) -> (a, b) -> f (b, b)
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 b -> f b
forall (f :: * -> *) a. Applicative f => a -> f a
pure) f (a, b)
as
  {-# INLINE traverse #-}

instance Foldable1 f => Foldable1 (AlongsideLeft f b) where
  foldMap1 :: (a -> m) -> AlongsideLeft f b a -> m
foldMap1 a -> m
f = ((a, b) -> m) -> f (a, b) -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 (a -> m
f (a -> m) -> ((a, b) -> a) -> (a, b) -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b) -> a
forall a b. (a, b) -> a
fst) (f (a, b) -> m)
-> (AlongsideLeft f b a -> f (a, b)) -> AlongsideLeft f b a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlongsideLeft f b a -> f (a, b)
forall (f :: * -> *) b a. AlongsideLeft f b a -> f (a, b)
getAlongsideLeft
  {-# INLINE foldMap1 #-}

instance Traversable1 f => Traversable1 (AlongsideLeft f b) where
  traverse1 :: (a -> f b) -> AlongsideLeft f b a -> f (AlongsideLeft f b b)
traverse1 a -> f b
f (AlongsideLeft f (a, b)
as) = f (b, b) -> AlongsideLeft f b b
forall (f :: * -> *) b a. f (a, b) -> AlongsideLeft f b a
AlongsideLeft (f (b, b) -> AlongsideLeft f b b)
-> f (f (b, b)) -> f (AlongsideLeft f b b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((a, b) -> f (b, b)) -> f (a, b) -> f (f (b, b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable1 t, Apply f) =>
(a -> f b) -> t a -> f (t b)
traverse1 (\(a
a,b
b) -> (b -> b -> (b, b)) -> b -> b -> (b, b)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) b
b (b -> (b, b)) -> f b -> f (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 :: (a -> b) -> (c -> d) -> AlongsideLeft f a c -> AlongsideLeft f b d
bimap a -> b
f c -> d
g = f (d, b) -> AlongsideLeft f b d
forall (f :: * -> *) b a. f (a, b) -> AlongsideLeft f b a
AlongsideLeft (f (d, b) -> AlongsideLeft f b d)
-> (AlongsideLeft f a c -> f (d, b))
-> AlongsideLeft f a c
-> AlongsideLeft f b d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((c, a) -> (d, b)) -> f (c, a) -> f (d, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((c -> d) -> (a -> b) -> (c, a) -> (d, b)
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) (f (c, a) -> f (d, b))
-> (AlongsideLeft f a c -> f (c, a))
-> AlongsideLeft f a c
-> f (d, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlongsideLeft f a c -> f (c, a)
forall (f :: * -> *) b a. AlongsideLeft f b a -> f (a, b)
getAlongsideLeft
  {-# INLINE bimap #-}

instance Foldable f => Bifoldable (AlongsideLeft f) where
  bifoldMap :: (a -> m) -> (b -> m) -> AlongsideLeft f a b -> m
bifoldMap a -> m
f b -> m
g = ((b, a) -> m) -> f (b, a) -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((b -> m) -> (a -> m) -> (b, a) -> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap b -> m
g a -> m
f) (f (b, a) -> m)
-> (AlongsideLeft f a b -> f (b, a)) -> AlongsideLeft f a b -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlongsideLeft f a b -> f (b, a)
forall (f :: * -> *) b a. AlongsideLeft f b a -> f (a, b)
getAlongsideLeft
  {-# INLINE bifoldMap #-}

instance Traversable f => Bitraversable (AlongsideLeft f) where
  bitraverse :: (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) = f (d, c) -> AlongsideLeft f c d
forall (f :: * -> *) b a. f (a, b) -> AlongsideLeft f b a
AlongsideLeft (f (d, c) -> AlongsideLeft f c d)
-> f (f (d, c)) -> f (AlongsideLeft f c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((b, a) -> f (d, c)) -> f (b, a) -> f (f (d, c))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((b -> f d) -> (a -> f c) -> (b, a) -> f (d, c)
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 { 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 :: (a -> b) -> AlongsideRight f a a -> AlongsideRight f a b
fmap a -> b
f (AlongsideRight f (a, a)
x) = f (a, b) -> AlongsideRight f a b
forall (f :: * -> *) a b. f (a, b) -> AlongsideRight f a b
AlongsideRight (((a, a) -> (a, b)) -> f (a, a) -> f (a, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> (a, a) -> (a, b)
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 :: (a -> b) -> AlongsideRight f a b -> AlongsideRight f a a
contramap a -> b
f (AlongsideRight f (a, b)
x) = f (a, a) -> AlongsideRight f a a
forall (f :: * -> *) a b. f (a, b) -> AlongsideRight f a b
AlongsideRight (((a, a) -> (a, b)) -> f (a, b) -> f (a, a)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap ((a -> b) -> (a, a) -> (a, b)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second a -> b
f) f (a, b)
x)
  {-# INLINE contramap #-}

instance Foldable f => Foldable (AlongsideRight f a) where
  foldMap :: (a -> m) -> AlongsideRight f a a -> m
foldMap a -> m
f = ((a, a) -> m) -> f (a, a) -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (a -> m
f (a -> m) -> ((a, a) -> a) -> (a, a) -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, a) -> a
forall a b. (a, b) -> b
snd) (f (a, a) -> m)
-> (AlongsideRight f a a -> f (a, a)) -> AlongsideRight f a a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlongsideRight f a a -> f (a, a)
forall (f :: * -> *) a b. AlongsideRight f a b -> f (a, b)
getAlongsideRight
  {-# INLINE foldMap #-}

instance Traversable f => Traversable (AlongsideRight f a) where
  traverse :: (a -> f b) -> AlongsideRight f a a -> f (AlongsideRight f a b)
traverse a -> f b
f (AlongsideRight f (a, a)
as) = f (a, b) -> AlongsideRight f a b
forall (f :: * -> *) a b. f (a, b) -> AlongsideRight f a b
AlongsideRight (f (a, b) -> AlongsideRight f a b)
-> f (f (a, b)) -> f (AlongsideRight f a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((a, a) -> f (a, b)) -> f (a, a) -> f (f (a, b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((a -> f a) -> (a -> f b) -> (a, a) -> f (a, b)
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 a
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 :: (a -> m) -> AlongsideRight f a a -> m
foldMap1 a -> m
f = ((a, a) -> m) -> f (a, a) -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 (a -> m
f (a -> m) -> ((a, a) -> a) -> (a, a) -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, a) -> a
forall a b. (a, b) -> b
snd) (f (a, a) -> m)
-> (AlongsideRight f a a -> f (a, a)) -> AlongsideRight f a a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlongsideRight f a a -> f (a, a)
forall (f :: * -> *) a b. AlongsideRight f a b -> f (a, b)
getAlongsideRight
  {-# INLINE foldMap1 #-}

instance Traversable1 f => Traversable1 (AlongsideRight f a) where
  traverse1 :: (a -> f b) -> AlongsideRight f a a -> f (AlongsideRight f a b)
traverse1 a -> f b
f (AlongsideRight f (a, a)
as) = f (a, b) -> AlongsideRight f a b
forall (f :: * -> *) a b. f (a, b) -> AlongsideRight f a b
AlongsideRight (f (a, b) -> AlongsideRight f a b)
-> f (f (a, b)) -> f (AlongsideRight f a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((a, a) -> f (a, b)) -> f (a, a) -> f (f (a, 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 (b -> (a, b)) -> f b -> f (a, b)
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 :: (a -> b)
-> (c -> d) -> AlongsideRight f a c -> AlongsideRight f b d
bimap a -> b
f c -> d
g = f (b, d) -> AlongsideRight f b d
forall (f :: * -> *) a b. f (a, b) -> AlongsideRight f a b
AlongsideRight (f (b, d) -> AlongsideRight f b d)
-> (AlongsideRight f a c -> f (b, d))
-> AlongsideRight f a c
-> AlongsideRight f b d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, c) -> (b, d)) -> f (a, c) -> f (b, d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> (c -> d) -> (a, c) -> (b, d)
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) (f (a, c) -> f (b, d))
-> (AlongsideRight f a c -> f (a, c))
-> AlongsideRight f a c
-> f (b, d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlongsideRight f a c -> f (a, c)
forall (f :: * -> *) a b. AlongsideRight f a b -> f (a, b)
getAlongsideRight
  {-# INLINE bimap #-}

instance Foldable f => Bifoldable (AlongsideRight f) where
  bifoldMap :: (a -> m) -> (b -> m) -> AlongsideRight f a b -> m
bifoldMap a -> m
f b -> m
g = ((a, b) -> m) -> f (a, b) -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((a -> m) -> (b -> m) -> (a, b) -> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap a -> m
f b -> m
g) (f (a, b) -> m)
-> (AlongsideRight f a b -> f (a, b)) -> AlongsideRight f a b -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlongsideRight f a b -> f (a, b)
forall (f :: * -> *) a b. AlongsideRight f a b -> f (a, b)
getAlongsideRight
  {-# INLINE bifoldMap #-}

instance Traversable f => Bitraversable (AlongsideRight f) where
  bitraverse :: (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) = f (c, d) -> AlongsideRight f c d
forall (f :: * -> *) a b. f (a, b) -> AlongsideRight f a b
AlongsideRight (f (c, d) -> AlongsideRight f c d)
-> f (f (c, d)) -> f (AlongsideRight f c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((a, b) -> f (c, d)) -> f (a, b) -> f (f (c, d))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((a -> f c) -> (b -> f d) -> (a, b) -> f (c, d)
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 #-}