{-# 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