{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE Safe #-}
-----------------------------------------------------------------------------
-- |
-- Copyright   :  (C) 2015-2018 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  experimental
-- Portability :  portable
--
----------------------------------------------------------------------------
module Data.Profunctor.Mapping
  ( Mapping(..)
  , CofreeMapping(..)
  , FreeMapping(..)
  -- * Traversing in terms of Mapping
  , wanderMapping
  -- * Closed in terms of Mapping
  , traverseMapping
  , closedMapping
  ) where

import Control.Arrow (Kleisli(..))
import Data.Bifunctor.Tannen
import Data.Distributive
import Data.Functor.Compose
import Data.Functor.Identity
import Data.Profunctor.Choice
import Data.Profunctor.Closed
import Data.Profunctor.Monad
import Data.Profunctor.Strong
import Data.Profunctor.Traversing
import Data.Profunctor.Types
import Data.Profunctor.Unsafe
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative
#endif

class (Traversing p, Closed p) => Mapping p where
  -- | Laws:
  --
  -- @
  -- 'map'' '.' 'rmap' f ≡ 'rmap' ('fmap' f) '.' 'map''
  -- 'map'' '.' 'map'' ≡ 'dimap' 'Data.Functor.Compose.Compose' 'Data.Functor.Compose.getCompose' '.' 'map''
  -- 'dimap' 'Data.Functor.Identity.Identity' 'Data.Functor.Identity.runIdentity' '.' 'map'' ≡ 'id'
  -- @
  map' :: Functor f => p a b -> p (f a) (f b)
  map' = ((a -> b) -> f a -> f b) -> p a b -> p (f a) (f b)
forall (p :: * -> * -> *) a b s t.
Mapping p =>
((a -> b) -> s -> t) -> p a b -> p s t
roam (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

  roam :: ((a -> b) -> s -> t)
       -> p a b -> p s t
  roam (a -> b) -> s -> t
f = (s -> Bar t b a)
-> (Bar t b b -> t) -> p (Bar t b a) (Bar t b b) -> p s t
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap (\s
s -> ((a -> b) -> t) -> Bar t b a
forall t b a. ((a -> b) -> t) -> Bar t b a
Bar (((a -> b) -> t) -> Bar t b a) -> ((a -> b) -> t) -> Bar t b a
forall a b. (a -> b) -> a -> b
$ \a -> b
ab -> (a -> b) -> s -> t
f a -> b
ab s
s) Bar t b b -> t
forall t a. Bar t a a -> t
lent (p (Bar t b a) (Bar t b b) -> p s t)
-> (p a b -> p (Bar t b a) (Bar t b b)) -> p a b -> p s t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a b -> p (Bar t b a) (Bar t b b)
forall (p :: * -> * -> *) (f :: * -> *) a b.
(Mapping p, Functor f) =>
p a b -> p (f a) (f b)
map'

newtype Bar t b a = Bar
  { Bar t b a -> (a -> b) -> t
runBar :: (a -> b) -> t }
  deriving a -> Bar t b b -> Bar t b a
(a -> b) -> Bar t b a -> Bar t b b
(forall a b. (a -> b) -> Bar t b a -> Bar t b b)
-> (forall a b. a -> Bar t b b -> Bar t b a) -> Functor (Bar t b)
forall a b. a -> Bar t b b -> Bar t b a
forall a b. (a -> b) -> Bar t b a -> Bar t b b
forall t b a b. a -> Bar t b b -> Bar t b a
forall t b a b. (a -> b) -> Bar t b a -> Bar t b b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Bar t b b -> Bar t b a
$c<$ :: forall t b a b. a -> Bar t b b -> Bar t b a
fmap :: (a -> b) -> Bar t b a -> Bar t b b
$cfmap :: forall t b a b. (a -> b) -> Bar t b a -> Bar t b b
Functor

lent :: Bar t a a -> t
lent :: Bar t a a -> t
lent Bar t a a
m = Bar t a a -> (a -> a) -> t
forall t b a. Bar t b a -> (a -> b) -> t
runBar Bar t a a
m a -> a
forall a. a -> a
id

instance Mapping (->) where
  map' :: (a -> b) -> f a -> f b
map' = (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
  roam :: ((a -> b) -> s -> t) -> (a -> b) -> s -> t
roam (a -> b) -> s -> t
f = (a -> b) -> s -> t
f

instance (Monad m, Distributive m) => Mapping (Kleisli m) where
  map' :: Kleisli m a b -> Kleisli m (f a) (f b)
map' (Kleisli a -> m b
f) = (f a -> m (f b)) -> Kleisli m (f a) (f b)
forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli ((a -> m b) -> f a -> m (f b)
forall (g :: * -> *) (f :: * -> *) a b.
(Distributive g, Functor f) =>
(a -> g b) -> f a -> g (f b)
collect a -> m b
f)
#if __GLASGOW_HASKELL__ >= 710
  roam :: ((a -> b) -> s -> t) -> Kleisli m a b -> Kleisli m s t
roam (a -> b) -> s -> t
f = (s -> m t) -> Kleisli m s t
forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli ((s -> m t) -> Kleisli m s t)
-> ((a -> m b) -> s -> m t) -> (a -> m b) -> Kleisli m s t
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. ((a -> b) -> s -> t) -> (a -> m b) -> s -> m t
forall (f :: * -> *) a b s t.
Distributive f =>
((a -> b) -> s -> t) -> (a -> f b) -> s -> f t
genMap (a -> b) -> s -> t
f ((a -> m b) -> Kleisli m s t)
-> (Kleisli m a b -> a -> m b) -> Kleisli m a b -> Kleisli m s t
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# Kleisli m a b -> a -> m b
forall (m :: * -> *) a b. Kleisli m a b -> a -> m b
runKleisli
#else
  -- We could actually use this implementation everywhere, but it's kind of a
  -- warty mess, and there have been rumblings of WrappedMonad deprecation.
  -- If/when GHC 7.8 moves out of the support window, this will vanish in a
  -- puff of cleanup.
  roam f = (Kleisli . (unwrapMonad .)) #. genMapW f .# ((WrapMonad .) . runKleisli)
    where
      genMapW
        :: (Monad m, Distributive m)
        => ((a -> b) -> s -> t)
        -> (a -> WrappedMonad m b) -> s -> WrappedMonad m t
      genMapW abst amb s = WrapMonad $ (\ab -> abst ab s) <$> distribute (unwrapMonad #. amb)
#endif

genMap :: Distributive f => ((a -> b) -> s -> t) -> (a -> f b) -> s -> f t
genMap :: ((a -> b) -> s -> t) -> (a -> f b) -> s -> f t
genMap (a -> b) -> s -> t
abst a -> f b
afb s
s = ((a -> b) -> t) -> f (a -> b) -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a -> b
ab -> (a -> b) -> s -> t
abst a -> b
ab s
s) ((a -> f b) -> f (a -> b)
forall (g :: * -> *) (f :: * -> *) a.
(Distributive g, Functor f) =>
f (g a) -> g (f a)
distribute a -> f b
afb)

-- see <https://github.com/ekmett/distributive/issues/12>
instance (Applicative m, Distributive m) => Mapping (Star m) where
  map' :: Star m a b -> Star m (f a) (f b)
map' (Star a -> m b
f) = (f a -> m (f b)) -> Star m (f a) (f b)
forall k (f :: k -> *) d (c :: k). (d -> f c) -> Star f d c
Star ((a -> m b) -> f a -> m (f b)
forall (g :: * -> *) (f :: * -> *) a b.
(Distributive g, Functor f) =>
(a -> g b) -> f a -> g (f b)
collect a -> m b
f)
  roam :: ((a -> b) -> s -> t) -> Star m a b -> Star m s t
roam (a -> b) -> s -> t
f = (s -> m t) -> Star m s t
forall k (f :: k -> *) d (c :: k). (d -> f c) -> Star f d c
Star ((s -> m t) -> Star m s t)
-> ((a -> m b) -> s -> m t) -> (a -> m b) -> Star m s t
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. ((a -> b) -> s -> t) -> (a -> m b) -> s -> m t
forall (f :: * -> *) a b s t.
Distributive f =>
((a -> b) -> s -> t) -> (a -> f b) -> s -> f t
genMap (a -> b) -> s -> t
f ((a -> m b) -> Star m s t)
-> (Star m a b -> a -> m b) -> Star m a b -> Star m s t
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# Star m a b -> a -> m b
forall k (f :: k -> *) d (c :: k). Star f d c -> d -> f c
runStar

instance (Functor f, Mapping p) => Mapping (Tannen f p) where
  map' :: Tannen f p a b -> Tannen f p (f a) (f b)
map' = f (p (f a) (f b)) -> Tannen f p (f a) (f b)
forall k k1 k2 (f :: k -> *) (p :: k1 -> k2 -> k) (a :: k1)
       (b :: k2).
f (p a b) -> Tannen f p a b
Tannen (f (p (f a) (f b)) -> Tannen f p (f a) (f b))
-> (Tannen f p a b -> f (p (f a) (f b)))
-> Tannen f p a b
-> Tannen f p (f a) (f b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (p a b -> p (f a) (f b)) -> f (p a b) -> f (p (f a) (f b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap p a b -> p (f a) (f b)
forall (p :: * -> * -> *) (f :: * -> *) a b.
(Mapping p, Functor f) =>
p a b -> p (f a) (f b)
map' (f (p a b) -> f (p (f a) (f b)))
-> (Tannen f p a b -> f (p a b))
-> Tannen f p a b
-> f (p (f a) (f b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tannen f p a b -> f (p a b)
forall k1 (f :: k1 -> *) k2 k3 (p :: k2 -> k3 -> k1) (a :: k2)
       (b :: k3).
Tannen f p a b -> f (p a b)
runTannen

wanderMapping :: Mapping p => (forall f. Applicative f => (a -> f b) -> s -> f t) -> p a b -> p s t
wanderMapping :: (forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> p a b -> p s t
wanderMapping forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t
f = ((a -> b) -> s -> t) -> p a b -> p s t
forall (p :: * -> * -> *) a b s t.
Mapping p =>
((a -> b) -> s -> t) -> p a b -> p s t
roam ((Identity t -> t
forall a. Identity a -> a
runIdentity (Identity t -> t) -> (s -> Identity t) -> s -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((s -> Identity t) -> s -> t)
-> ((a -> Identity b) -> s -> Identity t)
-> (a -> Identity b)
-> s
-> t
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. (a -> Identity b) -> s -> Identity t
forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t
f ((a -> Identity b) -> s -> t)
-> ((a -> b) -> a -> Identity b) -> (a -> b) -> s -> t
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# (b -> Identity b
forall a. a -> Identity a
Identity (b -> Identity b) -> (a -> b) -> a -> Identity b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.))

traverseMapping :: (Mapping p, Functor f) => p a b -> p (f a) (f b)
traverseMapping :: p a b -> p (f a) (f b)
traverseMapping = p a b -> p (f a) (f b)
forall (p :: * -> * -> *) (f :: * -> *) a b.
(Mapping p, Functor f) =>
p a b -> p (f a) (f b)
map'

closedMapping :: Mapping p => p a b -> p (x -> a) (x -> b)
closedMapping :: p a b -> p (x -> a) (x -> b)
closedMapping = p a b -> p (x -> a) (x -> b)
forall (p :: * -> * -> *) (f :: * -> *) a b.
(Mapping p, Functor f) =>
p a b -> p (f a) (f b)
map'

newtype CofreeMapping p a b = CofreeMapping { CofreeMapping p a b
-> forall (f :: * -> *). Functor f => p (f a) (f b)
runCofreeMapping :: forall f. Functor f => p (f a) (f b) }

instance Profunctor p => Profunctor (CofreeMapping p) where
  lmap :: (a -> b) -> CofreeMapping p b c -> CofreeMapping p a c
lmap a -> b
f (CofreeMapping forall (f :: * -> *). Functor f => p (f b) (f c)
p) = (forall (f :: * -> *). Functor f => p (f a) (f c))
-> CofreeMapping p a c
forall (p :: * -> * -> *) a b.
(forall (f :: * -> *). Functor f => p (f a) (f b))
-> CofreeMapping p a b
CofreeMapping ((f a -> f b) -> p (f b) (f c) -> p (f a) (f c)
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap ((a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) p (f b) (f c)
forall (f :: * -> *). Functor f => p (f b) (f c)
p)
  rmap :: (b -> c) -> CofreeMapping p a b -> CofreeMapping p a c
rmap b -> c
g (CofreeMapping forall (f :: * -> *). Functor f => p (f a) (f b)
p) = (forall (f :: * -> *). Functor f => p (f a) (f c))
-> CofreeMapping p a c
forall (p :: * -> * -> *) a b.
(forall (f :: * -> *). Functor f => p (f a) (f b))
-> CofreeMapping p a b
CofreeMapping ((f b -> f c) -> p (f a) (f b) -> p (f a) (f c)
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap ((b -> c) -> f b -> f c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
g) p (f a) (f b)
forall (f :: * -> *). Functor f => p (f a) (f b)
p)
  dimap :: (a -> b) -> (c -> d) -> CofreeMapping p b c -> CofreeMapping p a d
dimap a -> b
f c -> d
g (CofreeMapping forall (f :: * -> *). Functor f => p (f b) (f c)
p) = (forall (f :: * -> *). Functor f => p (f a) (f d))
-> CofreeMapping p a d
forall (p :: * -> * -> *) a b.
(forall (f :: * -> *). Functor f => p (f a) (f b))
-> CofreeMapping p a b
CofreeMapping ((f a -> f b) -> (f c -> f d) -> p (f b) (f c) -> p (f a) (f d)
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap ((a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) ((c -> d) -> f c -> f d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g) p (f b) (f c)
forall (f :: * -> *). Functor f => p (f b) (f c)
p)

instance Profunctor p => Strong (CofreeMapping p) where
  second' :: CofreeMapping p a b -> CofreeMapping p (c, a) (c, b)
second' = CofreeMapping p a b -> CofreeMapping p (c, a) (c, b)
forall (p :: * -> * -> *) (f :: * -> *) a b.
(Mapping p, Functor f) =>
p a b -> p (f a) (f b)
map'

instance Profunctor p => Choice (CofreeMapping p) where
  right' :: CofreeMapping p a b -> CofreeMapping p (Either c a) (Either c b)
right' = CofreeMapping p a b -> CofreeMapping p (Either c a) (Either c b)
forall (p :: * -> * -> *) (f :: * -> *) a b.
(Mapping p, Functor f) =>
p a b -> p (f a) (f b)
map'

instance Profunctor p => Closed (CofreeMapping p) where
  closed :: CofreeMapping p a b -> CofreeMapping p (x -> a) (x -> b)
closed = CofreeMapping p a b -> CofreeMapping p (x -> a) (x -> b)
forall (p :: * -> * -> *) (f :: * -> *) a b.
(Mapping p, Functor f) =>
p a b -> p (f a) (f b)
map'

instance Profunctor p => Traversing (CofreeMapping p) where
  traverse' :: CofreeMapping p a b -> CofreeMapping p (f a) (f b)
traverse' = CofreeMapping p a b -> CofreeMapping p (f a) (f b)
forall (p :: * -> * -> *) (f :: * -> *) a b.
(Mapping p, Functor f) =>
p a b -> p (f a) (f b)
map'
  wander :: (forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> CofreeMapping p a b -> CofreeMapping p s t
wander forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t
f = ((a -> b) -> s -> t) -> CofreeMapping p a b -> CofreeMapping p s t
forall (p :: * -> * -> *) a b s t.
Mapping p =>
((a -> b) -> s -> t) -> p a b -> p s t
roam (((a -> b) -> s -> t)
 -> CofreeMapping p a b -> CofreeMapping p s t)
-> ((a -> b) -> s -> t)
-> CofreeMapping p a b
-> CofreeMapping p s t
forall a b. (a -> b) -> a -> b
$ (Identity t -> t
forall a. Identity a -> a
runIdentity (Identity t -> t) -> (s -> Identity t) -> s -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((s -> Identity t) -> s -> t)
-> ((a -> Identity b) -> s -> Identity t)
-> (a -> Identity b)
-> s
-> t
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. (a -> Identity b) -> s -> Identity t
forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t
f ((a -> Identity b) -> s -> t)
-> ((a -> b) -> a -> Identity b) -> (a -> b) -> s -> t
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# (b -> Identity b
forall a. a -> Identity a
Identity (b -> Identity b) -> (a -> b) -> a -> Identity b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.)

instance Profunctor p => Mapping (CofreeMapping p) where
  -- !@(#*&() Compose isn't representational in its second arg or we could use #. and .#
  map' :: CofreeMapping p a b -> CofreeMapping p (f a) (f b)
map' (CofreeMapping forall (f :: * -> *). Functor f => p (f a) (f b)
p) = (forall (f :: * -> *). Functor f => p (f (f a)) (f (f b)))
-> CofreeMapping p (f a) (f b)
forall (p :: * -> * -> *) a b.
(forall (f :: * -> *). Functor f => p (f a) (f b))
-> CofreeMapping p a b
CofreeMapping ((f (f a) -> Compose f f a)
-> (Compose f f b -> f (f b))
-> p (Compose f f a) (Compose f f b)
-> p (f (f a)) (f (f b))
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap f (f a) -> Compose f f a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose Compose f f b -> f (f b)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose p (Compose f f a) (Compose f f b)
forall (f :: * -> *). Functor f => p (f a) (f b)
p)
  roam :: ((a -> b) -> s -> t) -> CofreeMapping p a b -> CofreeMapping p s t
roam (a -> b) -> s -> t
f (CofreeMapping forall (f :: * -> *). Functor f => p (f a) (f b)
p) =
     (forall (f :: * -> *). Functor f => p (f s) (f t))
-> CofreeMapping p s t
forall (p :: * -> * -> *) a b.
(forall (f :: * -> *). Functor f => p (f a) (f b))
-> CofreeMapping p a b
CofreeMapping ((forall (f :: * -> *). Functor f => p (f s) (f t))
 -> CofreeMapping p s t)
-> (forall (f :: * -> *). Functor f => p (f s) (f t))
-> CofreeMapping p s t
forall a b. (a -> b) -> a -> b
$
       (f s -> Compose f (Bar t b) a)
-> (Compose f (Bar t b) b -> f t)
-> p (Compose f (Bar t b) a) (Compose f (Bar t b) b)
-> p (f s) (f t)
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap (f (Bar t b a) -> Compose f (Bar t b) a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f (Bar t b a) -> Compose f (Bar t b) a)
-> (f s -> f (Bar t b a)) -> f s -> Compose f (Bar t b) a
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. (s -> Bar t b a) -> f s -> f (Bar t b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\s
s -> ((a -> b) -> t) -> Bar t b a
forall t b a. ((a -> b) -> t) -> Bar t b a
Bar (((a -> b) -> t) -> Bar t b a) -> ((a -> b) -> t) -> Bar t b a
forall a b. (a -> b) -> a -> b
$ \a -> b
ab -> (a -> b) -> s -> t
f a -> b
ab s
s)) ((Bar t b b -> t) -> f (Bar t b b) -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bar t b b -> t
forall t a. Bar t a a -> t
lent (f (Bar t b b) -> f t)
-> (Compose f (Bar t b) b -> f (Bar t b b))
-> Compose f (Bar t b) b
-> f t
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# Compose f (Bar t b) b -> f (Bar t b b)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose) p (Compose f (Bar t b) a) (Compose f (Bar t b) b)
forall (f :: * -> *). Functor f => p (f a) (f b)
p

instance ProfunctorFunctor CofreeMapping where
  promap :: (p :-> q) -> CofreeMapping p :-> CofreeMapping q
promap p :-> q
f (CofreeMapping forall (f :: * -> *). Functor f => p (f a) (f b)
p) = (forall (f :: * -> *). Functor f => q (f a) (f b))
-> CofreeMapping q a b
forall (p :: * -> * -> *) a b.
(forall (f :: * -> *). Functor f => p (f a) (f b))
-> CofreeMapping p a b
CofreeMapping (p (f a) (f b) -> q (f a) (f b)
p :-> q
f p (f a) (f b)
forall (f :: * -> *). Functor f => p (f a) (f b)
p)

instance ProfunctorComonad CofreeMapping where
  proextract :: CofreeMapping p :-> p
proextract (CofreeMapping forall (f :: * -> *). Functor f => p (f a) (f b)
p) = Identity b -> b
forall a. Identity a -> a
runIdentity (Identity b -> b)
-> p (Identity a) (Identity b) -> p (Identity a) b
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. p (Identity a) (Identity b)
forall (f :: * -> *). Functor f => p (f a) (f b)
p p (Identity a) b -> (a -> Identity a) -> p a b
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# a -> Identity a
forall a. a -> Identity a
Identity
  produplicate :: CofreeMapping p :-> CofreeMapping (CofreeMapping p)
produplicate (CofreeMapping forall (f :: * -> *). Functor f => p (f a) (f b)
p) = (forall (f :: * -> *). Functor f => CofreeMapping p (f a) (f b))
-> CofreeMapping (CofreeMapping p) a b
forall (p :: * -> * -> *) a b.
(forall (f :: * -> *). Functor f => p (f a) (f b))
-> CofreeMapping p a b
CofreeMapping ((forall (f :: * -> *). Functor f => p (f (f a)) (f (f b)))
-> CofreeMapping p (f a) (f b)
forall (p :: * -> * -> *) a b.
(forall (f :: * -> *). Functor f => p (f a) (f b))
-> CofreeMapping p a b
CofreeMapping ((f (f a) -> Compose f f a)
-> (Compose f f b -> f (f b))
-> p (Compose f f a) (Compose f f b)
-> p (f (f a)) (f (f b))
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap f (f a) -> Compose f f a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose Compose f f b -> f (f b)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose p (Compose f f a) (Compose f f b)
forall (f :: * -> *). Functor f => p (f a) (f b)
p))

-- | @FreeMapping -| CofreeMapping@
data FreeMapping p a b where
  FreeMapping :: Functor f => (f y -> b) -> p x y -> (a -> f x) -> FreeMapping p a b

instance Functor (FreeMapping p a) where
  fmap :: (a -> b) -> FreeMapping p a a -> FreeMapping p a b
fmap a -> b
f (FreeMapping f y -> a
l p x y
m a -> f x
r) = (f y -> b) -> p x y -> (a -> f x) -> FreeMapping p a b
forall (f :: * -> *) y b (p :: * -> * -> *) x a.
Functor f =>
(f y -> b) -> p x y -> (a -> f x) -> FreeMapping p a b
FreeMapping (a -> b
f (a -> b) -> (f y -> a) -> f y -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f y -> a
l) p x y
m a -> f x
r

instance Profunctor (FreeMapping p) where
  lmap :: (a -> b) -> FreeMapping p b c -> FreeMapping p a c
lmap a -> b
f (FreeMapping f y -> c
l p x y
m b -> f x
r) = (f y -> c) -> p x y -> (a -> f x) -> FreeMapping p a c
forall (f :: * -> *) y b (p :: * -> * -> *) x a.
Functor f =>
(f y -> b) -> p x y -> (a -> f x) -> FreeMapping p a b
FreeMapping f y -> c
l p x y
m (b -> f x
r (b -> f x) -> (a -> b) -> a -> f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  rmap :: (b -> c) -> FreeMapping p a b -> FreeMapping p a c
rmap b -> c
g (FreeMapping f y -> b
l p x y
m a -> f x
r) = (f y -> c) -> p x y -> (a -> f x) -> FreeMapping p a c
forall (f :: * -> *) y b (p :: * -> * -> *) x a.
Functor f =>
(f y -> b) -> p x y -> (a -> f x) -> FreeMapping p a b
FreeMapping (b -> c
g (b -> c) -> (f y -> b) -> f y -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f y -> b
l) p x y
m a -> f x
r
  dimap :: (a -> b) -> (c -> d) -> FreeMapping p b c -> FreeMapping p a d
dimap a -> b
f c -> d
g (FreeMapping f y -> c
l p x y
m b -> f x
r) = (f y -> d) -> p x y -> (a -> f x) -> FreeMapping p a d
forall (f :: * -> *) y b (p :: * -> * -> *) x a.
Functor f =>
(f y -> b) -> p x y -> (a -> f x) -> FreeMapping p a b
FreeMapping (c -> d
g (c -> d) -> (f y -> c) -> f y -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f y -> c
l) p x y
m (b -> f x
r (b -> f x) -> (a -> b) -> a -> f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  q b c
g #. :: q b c -> FreeMapping p a b -> FreeMapping p a c
#. FreeMapping f y -> b
l p x y
m a -> f x
r = (f y -> c) -> p x y -> (a -> f x) -> FreeMapping p a c
forall (f :: * -> *) y b (p :: * -> * -> *) x a.
Functor f =>
(f y -> b) -> p x y -> (a -> f x) -> FreeMapping p a b
FreeMapping (q b c
g q b c -> (f y -> b) -> f y -> c
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. f y -> b
l) p x y
m a -> f x
r
  FreeMapping f y -> c
l p x y
m b -> f x
r .# :: FreeMapping p b c -> q a b -> FreeMapping p a c
.# q a b
f = (f y -> c) -> p x y -> (a -> f x) -> FreeMapping p a c
forall (f :: * -> *) y b (p :: * -> * -> *) x a.
Functor f =>
(f y -> b) -> p x y -> (a -> f x) -> FreeMapping p a b
FreeMapping f y -> c
l p x y
m (b -> f x
r (b -> f x) -> q a b -> a -> f x
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# q a b
f)

instance Strong (FreeMapping p) where
  second' :: FreeMapping p a b -> FreeMapping p (c, a) (c, b)
second' = FreeMapping p a b -> FreeMapping p (c, a) (c, b)
forall (p :: * -> * -> *) (f :: * -> *) a b.
(Mapping p, Functor f) =>
p a b -> p (f a) (f b)
map'

instance Choice (FreeMapping p) where
  right' :: FreeMapping p a b -> FreeMapping p (Either c a) (Either c b)
right' = FreeMapping p a b -> FreeMapping p (Either c a) (Either c b)
forall (p :: * -> * -> *) (f :: * -> *) a b.
(Mapping p, Functor f) =>
p a b -> p (f a) (f b)
map'

instance Closed (FreeMapping p) where
  closed :: FreeMapping p a b -> FreeMapping p (x -> a) (x -> b)
closed = FreeMapping p a b -> FreeMapping p (x -> a) (x -> b)
forall (p :: * -> * -> *) (f :: * -> *) a b.
(Mapping p, Functor f) =>
p a b -> p (f a) (f b)
map'

instance Traversing (FreeMapping p) where
  traverse' :: FreeMapping p a b -> FreeMapping p (f a) (f b)
traverse' = FreeMapping p a b -> FreeMapping p (f a) (f b)
forall (p :: * -> * -> *) (f :: * -> *) a b.
(Mapping p, Functor f) =>
p a b -> p (f a) (f b)
map'
  wander :: (forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> FreeMapping p a b -> FreeMapping p s t
wander forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t
f = ((a -> b) -> s -> t) -> FreeMapping p a b -> FreeMapping p s t
forall (p :: * -> * -> *) a b s t.
Mapping p =>
((a -> b) -> s -> t) -> p a b -> p s t
roam ((Identity t -> t
forall a. Identity a -> a
runIdentity (Identity t -> t) -> (s -> Identity t) -> s -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((s -> Identity t) -> s -> t)
-> ((a -> Identity b) -> s -> Identity t)
-> (a -> Identity b)
-> s
-> t
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. (a -> Identity b) -> s -> Identity t
forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t
f ((a -> Identity b) -> s -> t)
-> ((a -> b) -> a -> Identity b) -> (a -> b) -> s -> t
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# (b -> Identity b
forall a. a -> Identity a
Identity (b -> Identity b) -> (a -> b) -> a -> Identity b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.))

instance Mapping (FreeMapping p) where
  map' :: FreeMapping p a b -> FreeMapping p (f a) (f b)
map' (FreeMapping f y -> b
l p x y
m a -> f x
r) = (Compose f f y -> f b)
-> p x y -> (f a -> Compose f f x) -> FreeMapping p (f a) (f b)
forall (f :: * -> *) y b (p :: * -> * -> *) x a.
Functor f =>
(f y -> b) -> p x y -> (a -> f x) -> FreeMapping p a b
FreeMapping ((f y -> b) -> f (f y) -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f y -> b
l (f (f y) -> f b)
-> (Compose f f y -> f (f y)) -> Compose f f y -> f b
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# Compose f f y -> f (f y)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose) p x y
m (f (f x) -> Compose f f x
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f (f x) -> Compose f f x)
-> (f a -> f (f x)) -> f a -> Compose f f x
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. (a -> f x) -> f a -> f (f x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> f x
r)

instance ProfunctorFunctor FreeMapping where
  promap :: (p :-> q) -> FreeMapping p :-> FreeMapping q
promap p :-> q
f (FreeMapping f y -> b
l p x y
m a -> f x
r) = (f y -> b) -> q x y -> (a -> f x) -> FreeMapping q a b
forall (f :: * -> *) y b (p :: * -> * -> *) x a.
Functor f =>
(f y -> b) -> p x y -> (a -> f x) -> FreeMapping p a b
FreeMapping f y -> b
l (p x y -> q x y
p :-> q
f p x y
m) a -> f x
r

instance ProfunctorMonad FreeMapping where
  proreturn :: p :-> FreeMapping p
proreturn p a b
p = (Identity b -> b)
-> p a b -> (a -> Identity a) -> FreeMapping p a b
forall (f :: * -> *) y b (p :: * -> * -> *) x a.
Functor f =>
(f y -> b) -> p x y -> (a -> f x) -> FreeMapping p a b
FreeMapping Identity b -> b
forall a. Identity a -> a
runIdentity p a b
p a -> Identity a
forall a. a -> Identity a
Identity
  projoin :: FreeMapping (FreeMapping p) :-> FreeMapping p
projoin (FreeMapping f y -> b
l (FreeMapping f y -> y
l' p x y
m x -> f x
r') a -> f x
r) = (Compose f f y -> b)
-> p x y -> (a -> Compose f f x) -> FreeMapping p a b
forall (f :: * -> *) y b (p :: * -> * -> *) x a.
Functor f =>
(f y -> b) -> p x y -> (a -> f x) -> FreeMapping p a b
FreeMapping ((f y -> b
l (f y -> b) -> (f (f y) -> f y) -> f (f y) -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f y -> y) -> f (f y) -> f y
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f y -> y
l') (f (f y) -> b) -> (Compose f f y -> f (f y)) -> Compose f f y -> b
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# Compose f f y -> f (f y)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose) p x y
m (f (f x) -> Compose f f x
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f (f x) -> Compose f f x) -> (a -> f (f x)) -> a -> Compose f f x
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. ((x -> f x) -> f x -> f (f x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap x -> f x
r' (f x -> f (f x)) -> (a -> f x) -> a -> f (f x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f x
r))