module Control.Lens.Internal.Getter
(
coerce
, noEffect
, AlongsideLeft(..)
, AlongsideRight(..)
) where
import Control.Applicative
import Data.Bifoldable
import Data.Bifunctor
import Data.Bitraversable
import Data.Foldable
import Data.Functor.Contravariant
import Data.Semigroup.Foldable
import Data.Semigroup.Traversable
import Data.Traversable
import Data.Void
import Prelude
coerce :: (Contravariant f, Functor f) => f a -> f b
coerce a = absurd <$> contramap absurd a
noEffect :: (Contravariant f, Applicative f) => f a
noEffect = coerce $ pure ()
newtype AlongsideLeft f b a = AlongsideLeft { 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 f = AlongsideLeft . fmap (first f) . getAlongsideLeft
instance Contravariant f => Contravariant (AlongsideLeft f b) where
contramap f = AlongsideLeft . contramap (first f) . getAlongsideLeft
instance Foldable f => Foldable (AlongsideLeft f b) where
foldMap f = foldMap (f . fst) . getAlongsideLeft
instance Traversable f => Traversable (AlongsideLeft f b) where
traverse f (AlongsideLeft as) = AlongsideLeft <$> traverse (bitraverse f pure) as
instance Foldable1 f => Foldable1 (AlongsideLeft f b) where
foldMap1 f = foldMap1 (f . fst) . getAlongsideLeft
instance Traversable1 f => Traversable1 (AlongsideLeft f b) where
traverse1 f (AlongsideLeft as) = AlongsideLeft <$> traverse1 (\(a,b) -> flip (,) b <$> f a) as
instance Functor f => Bifunctor (AlongsideLeft f) where
bimap f g = AlongsideLeft . fmap (bimap g f) . getAlongsideLeft
instance Foldable f => Bifoldable (AlongsideLeft f) where
bifoldMap f g = foldMap (bifoldMap g f) . getAlongsideLeft
instance Traversable f => Bitraversable (AlongsideLeft f) where
bitraverse f g (AlongsideLeft as) = AlongsideLeft <$> traverse (bitraverse g f) as
newtype AlongsideRight f a b = AlongsideRight { 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 f (AlongsideRight x) = AlongsideRight (fmap (second f) x)
instance Contravariant f => Contravariant (AlongsideRight f a) where
contramap f (AlongsideRight x) = AlongsideRight (contramap (second f) x)
instance Foldable f => Foldable (AlongsideRight f a) where
foldMap f = foldMap (f . snd) . getAlongsideRight
instance Traversable f => Traversable (AlongsideRight f a) where
traverse f (AlongsideRight as) = AlongsideRight <$> traverse (bitraverse pure f) as
instance Foldable1 f => Foldable1 (AlongsideRight f a) where
foldMap1 f = foldMap1 (f . snd) . getAlongsideRight
instance Traversable1 f => Traversable1 (AlongsideRight f a) where
traverse1 f (AlongsideRight as) = AlongsideRight <$> traverse1 (\(a,b) -> (,) a <$> f b) as
instance Functor f => Bifunctor (AlongsideRight f) where
bimap f g = AlongsideRight . fmap (bimap f g) . getAlongsideRight
instance Foldable f => Bifoldable (AlongsideRight f) where
bifoldMap f g = foldMap (bifoldMap f g) . getAlongsideRight
instance Traversable f => Bitraversable (AlongsideRight f) where
bitraverse f g (AlongsideRight as) = AlongsideRight <$> traverse (bitraverse f g) as