{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-} module Data.Profunctor.MStrong where import Data.Profunctor import Data.Tagged import Data.Tuple class Profunctor p => MStrong p where mfirst' :: Monoid m => p a b -> p (a, m) (b, m) mfirst' = ((a, m) -> (m, a)) -> ((m, b) -> (b, m)) -> p (m, a) (m, b) -> p (a, m) (b, m) forall (p :: * -> * -> *) a b c d. Profunctor p => (a -> b) -> (c -> d) -> p b c -> p a d dimap (a, m) -> (m, a) forall a b. (a, b) -> (b, a) swap (m, b) -> (b, m) forall a b. (a, b) -> (b, a) swap (p (m, a) (m, b) -> p (a, m) (b, m)) -> (p a b -> p (m, a) (m, b)) -> p a b -> p (a, m) (b, m) forall b c a. (b -> c) -> (a -> b) -> a -> c . p a b -> p (m, a) (m, b) forall (p :: * -> * -> *) m a b. (MStrong p, Monoid m) => p a b -> p (m, a) (m, b) msecond' msecond' :: Monoid m => p a b -> p (m, a) (m, b) msecond' = ((m, a) -> (a, m)) -> ((b, m) -> (m, b)) -> p (a, m) (b, m) -> p (m, a) (m, b) forall (p :: * -> * -> *) a b c d. Profunctor p => (a -> b) -> (c -> d) -> p b c -> p a d dimap (m, a) -> (a, m) forall a b. (a, b) -> (b, a) swap (b, m) -> (m, b) forall a b. (a, b) -> (b, a) swap (p (a, m) (b, m) -> p (m, a) (m, b)) -> (p a b -> p (a, m) (b, m)) -> p a b -> p (m, a) (m, b) forall b c a. (b -> c) -> (a -> b) -> a -> c . p a b -> p (a, m) (b, m) forall (p :: * -> * -> *) m a b. (MStrong p, Monoid m) => p a b -> p (a, m) (b, m) mfirst' {-# MINIMAL mfirst' | msecond' #-} instance MStrong (Forget r) where msecond' :: Forget r a b -> Forget r (m, a) (m, b) msecond' = Forget r a b -> Forget r (m, a) (m, b) forall (p :: * -> * -> *) a b c. Strong p => p a b -> p (c, a) (c, b) second' instance MStrong (->) where msecond' :: (a -> b) -> (m, a) -> (m, b) msecond' = (a -> b) -> (m, a) -> (m, b) forall (p :: * -> * -> *) a b c. Strong p => p a b -> p (c, a) (c, b) second' instance Functor f => MStrong (Star f) where msecond' :: Star f a b -> Star f (m, a) (m, b) msecond' = Star f a b -> Star f (m, a) (m, b) forall (p :: * -> * -> *) a b c. Strong p => p a b -> p (c, a) (c, b) second' instance MStrong Tagged where msecond' :: Tagged a b -> Tagged (m, a) (m, b) msecond' (Tagged b :: b b) = (m, b) -> Tagged (m, a) (m, b) forall k (s :: k) b. b -> Tagged s b Tagged (m forall a. Monoid a => a mempty, b b) instance Traversable f => MStrong (Costar f) where msecond' :: Costar f a b -> Costar f (m, a) (m, b) msecond' (Costar f :: f a -> b f) = (f (m, a) -> (m, b)) -> Costar f (m, a) (m, b) forall (f :: * -> *) d c. (f d -> c) -> Costar f d c Costar f (m, a) -> (m, b) go where go :: f (m, a) -> (m, b) go fma :: f (m, a) fma = f a -> b f (f a -> b) -> (m, f a) -> (m, b) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> f (m, a) -> (m, f a) forall (t :: * -> *) (f :: * -> *) a. (Traversable t, Applicative f) => t (f a) -> f (t a) sequenceA f (m, a) fma