-----------------------------------------------------------------------------
-- |
-- Module      :  Generics.OneLiner.Classes
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  sjoerd@w3future.com
-- Stability   :  experimental
-- Portability :  non-portable
--
-----------------------------------------------------------------------------
{-# OPTIONS -Wno-orphans #-}
{-# LANGUAGE
    EmptyCase
  , LambdaCase
  , LinearTypes
  , TypeOperators
  , BlockArguments
  , MonoLocalBinds
  , FlexibleInstances
  , UndecidableInstances
  #-}
module Generics.OneLiner.Classes where

import GHC.Generics
import Control.Applicative
import Data.Bifunctor.Biff
import Data.Bifunctor.Clown
import Data.Bifunctor.Joker
import Data.Bifunctor.Product
import Data.Bifunctor.Tannen
import Data.Functor.Contravariant
import Data.Functor.Contravariant.Divisible
import Data.Functor.Compose
import Data.Kind (FUN)
import Data.Profunctor hiding (Profunctor(..))
import qualified Data.Profunctor as P
import Data.Profunctor.Linear (Profunctor(..))
import Data.Profunctor.Kleisli.Linear
import Data.Tagged
import Data.Unrestricted.Linear ()
import GHC.Types (Multiplicity(..))
import Prelude.Linear (forget)
import qualified Data.Functor.Linear as DL
import qualified Control.Functor.Linear as CL

-- | A generic function using a `GenericRecordProfunctor` works on any data type
-- with exactly one constructor, a.k.a. records,
-- with multiple fields (`mult`) or no fields (`unit`).
--
-- `GenericRecordProfunctor` is similar to `ProductProfuctor` from the
-- product-profunctor package, but using types from GHC.Generics.
class (Profunctor p, GenericUnitProfunctor p, GenericProductProfunctor p) => GenericRecordProfunctor p
instance (Profunctor p, GenericUnitProfunctor p, GenericProductProfunctor p) => GenericRecordProfunctor p

-- | A generic function using a `GenericNonEmptyProfunctor` works on any data
-- type with at least one constructor.
class (GenericRecordProfunctor p, GenericSumProfunctor p) => GenericNonEmptyProfunctor p where
instance (GenericRecordProfunctor p, GenericSumProfunctor p) => GenericNonEmptyProfunctor p where

-- | A generic function using a `GenericProfunctor` works on any
-- algebraic data type of kind @Type@, including those with no constructors and constants.
class (GenericNonEmptyProfunctor p, GenericEmptyProfunctor p) => GenericProfunctor p where
instance (GenericNonEmptyProfunctor p, GenericEmptyProfunctor p) => GenericProfunctor p where

-- | A generic function using a `Generic1Profunctor` works on any
-- algebraic data type of kind @Type -> Type@, including those with no constructors and constants.
class (GenericProfunctor p, GenericConstantProfunctor p) => Generic1Profunctor p where
instance (GenericProfunctor p, GenericConstantProfunctor p) => Generic1Profunctor p where


dimapForget :: P.Profunctor p => (a %1-> b) -> (c %1-> d) -> p b c -> p a d
dimapForget :: forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a %1 -> b) -> (c %1 -> d) -> p b c -> p a d
dimapForget a %1 -> b
l c %1 -> d
r = (a -> b) -> (c -> d) -> p b c -> p a d
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
P.dimap ((a %1 -> b) %1 -> a -> b
forall a b. (a %1 -> b) %1 -> a -> b
forget a %1 -> b
l) ((c %1 -> d) %1 -> c -> d
forall a b. (a %1 -> b) %1 -> a -> b
forget c %1 -> d
r)

class Profunctor p => GenericUnitProfunctor p where
  unit :: p (U1 a) (U1 a')

class Profunctor p => GenericProductProfunctor p where
  mult :: p (f a) (f' a') -> p (g a) (g' a') -> p ((f :*: g) a) ((f' :*: g') a')

class Profunctor p => GenericSumProfunctor p where
  plus :: p (f a) (f' a') -> p (g a) (g' a') -> p ((f :+: g) a) ((f' :+: g') a')

class Profunctor p => GenericConstantProfunctor p where
  identity :: p c c

class Profunctor p => GenericEmptyProfunctor p where
  zero :: p (V1 a) (V1 a')


instance Profunctor (FUN 'One) where
  dimap :: forall s a b t.
(s %1 -> a) -> (b %1 -> t) -> (a %1 -> b) -> s %1 -> t
dimap s %1 -> a
f b %1 -> t
g a %1 -> b
h = \s
x -> b %1 -> t
g (a %1 -> b
h (s %1 -> a
f s
x))
instance GenericUnitProfunctor (FUN 'One) where
  unit :: forall a a'. U1 a %1 -> U1 a'
unit U1 a
U1 = U1 a'
forall k (p :: k). U1 p
U1
  {-# INLINE unit #-}
instance GenericProductProfunctor (FUN 'One) where
  mult :: forall (f :: * -> *) a (f' :: * -> *) a' (g :: * -> *)
       (g' :: * -> *).
(f a %1 -> f' a')
-> (g a %1 -> g' a') -> (:*:) f g a %1 -> (:*:) f' g' a'
mult f a %1 -> f' a'
f g a %1 -> g' a'
g (f a
l :*: g a
r) = f a %1 -> f' a'
f f a
l f' a' %1 -> g' a' %1 -> (:*:) f' g' a'
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g a %1 -> g' a'
g g a
r
  {-# INLINE mult #-}
instance GenericSumProfunctor (FUN 'One) where
  plus :: forall (f :: * -> *) a (f' :: * -> *) a' (g :: * -> *)
       (g' :: * -> *).
(f a %1 -> f' a')
-> (g a %1 -> g' a') -> (:+:) f g a %1 -> (:+:) f' g' a'
plus f a %1 -> f' a'
f g a %1 -> g' a'
g = (f a %1 -> (:+:) f' g' a')
-> (g a %1 -> (:+:) f' g' a') -> (:+:) f g a %1 -> (:+:) f' g' a'
forall (f :: * -> *) a b (m :: Multiplicity) (g :: * -> *).
(f a %m -> b) -> (g a %m -> b) -> (:+:) f g a %m -> b
e1 (\f a
x -> f' a' %1 -> (:+:) f' g' a'
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (f a %1 -> f' a'
f f a
x)) (\g a
x -> g' a' %1 -> (:+:) f' g' a'
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (g a %1 -> g' a'
g g a
x))
  {-# INLINE plus #-}
instance GenericEmptyProfunctor (FUN 'One) where
  zero :: forall a a'. V1 a %1 -> V1 a'
zero = V1 a %1 -> V1 a'
\case
  {-# INLINE zero #-}
instance GenericConstantProfunctor (FUN 'One) where
  identity :: forall c. c %1 -> c
identity c
x = c
x
  {-# INLINE identity #-}

instance GenericUnitProfunctor (->) where
  unit :: forall a a'. U1 a -> U1 a'
unit U1 a
U1 = U1 a'
forall k (p :: k). U1 p
U1
  {-# INLINE unit #-}
instance GenericProductProfunctor (->) where
  mult :: forall (f :: * -> *) a (f' :: * -> *) a' (g :: * -> *)
       (g' :: * -> *).
(f a -> f' a') -> (g a -> g' a') -> (:*:) f g a -> (:*:) f' g' a'
mult f a -> f' a'
f g a -> g' a'
g (f a
l :*: g a
r) = f a -> f' a'
f f a
l f' a' -> g' a' -> (:*:) f' g' a'
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g a -> g' a'
g g a
r
  {-# INLINE mult #-}
instance GenericSumProfunctor (->) where
  plus :: forall (f :: * -> *) a (f' :: * -> *) a' (g :: * -> *)
       (g' :: * -> *).
(f a -> f' a') -> (g a -> g' a') -> (:+:) f g a -> (:+:) f' g' a'
plus f a -> f' a'
f g a -> g' a'
g = (f a -> (:+:) f' g' a')
-> (g a -> (:+:) f' g' a') -> (:+:) f g a -> (:+:) f' g' a'
forall (f :: * -> *) a b (m :: Multiplicity) (g :: * -> *).
(f a %m -> b) -> (g a %m -> b) -> (:+:) f g a %m -> b
e1 (\f a
x -> f' a' -> (:+:) f' g' a'
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (f a -> f' a'
f f a
x)) (\g a
x -> g' a' -> (:+:) f' g' a'
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (g a -> g' a'
g g a
x))
  {-# INLINE plus #-}
instance GenericEmptyProfunctor (->) where
  zero :: forall a a'. V1 a -> V1 a'
zero = V1 a -> V1 a'
\case
  {-# INLINE zero #-}
instance GenericConstantProfunctor (->) where
  identity :: forall c. c -> c
identity c
x = c
x
  {-# INLINE identity #-}

instance Profunctor Tagged where dimap :: forall s a b t.
(s %1 -> a) -> (b %1 -> t) -> Tagged a b -> Tagged s t
dimap = (s %1 -> a) -> (b %1 -> t) -> Tagged a b -> Tagged s t
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a %1 -> b) -> (c %1 -> d) -> p b c -> p a d
dimapForget
instance GenericUnitProfunctor Tagged where
  unit :: forall a a'. Tagged (U1 a) (U1 a')
unit = U1 a' -> Tagged (U1 a) (U1 a')
forall {k} (s :: k) b. b -> Tagged s b
Tagged U1 a'
forall k (p :: k). U1 p
U1
  {-# INLINE unit #-}
instance GenericProductProfunctor Tagged where
  mult :: forall (f :: * -> *) a (f' :: * -> *) a' (g :: * -> *)
       (g' :: * -> *).
Tagged (f a) (f' a')
-> Tagged (g a) (g' a') -> Tagged ((:*:) f g a) ((:*:) f' g' a')
mult (Tagged f' a'
l) (Tagged g' a'
r) = (:*:) f' g' a' -> Tagged ((:*:) f g a) ((:*:) f' g' a')
forall {k} (s :: k) b. b -> Tagged s b
Tagged ((:*:) f' g' a' -> Tagged ((:*:) f g a) ((:*:) f' g' a'))
-> (:*:) f' g' a' -> Tagged ((:*:) f g a) ((:*:) f' g' a')
forall a b. (a -> b) -> a -> b
$ f' a'
l f' a' -> g' a' -> (:*:) f' g' a'
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g' a'
r
  {-# INLINE mult #-}

instance Functor f => Profunctor (Star f) where dimap :: forall s a b t.
(s %1 -> a) -> (b %1 -> t) -> Star f a b -> Star f s t
dimap = (s %1 -> a) -> (b %1 -> t) -> Star f a b -> Star f s t
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a %1 -> b) -> (c %1 -> d) -> p b c -> p a d
dimapForget
instance Applicative f => GenericUnitProfunctor (Star f) where
  unit :: forall a a'. Star f (U1 a) (U1 a')
unit = (U1 a -> f (U1 a')) -> Star f (U1 a) (U1 a')
forall {k} (f :: k -> *) d (c :: k). (d -> f c) -> Star f d c
Star ((U1 a -> f (U1 a')) -> Star f (U1 a) (U1 a'))
-> (U1 a -> f (U1 a')) -> Star f (U1 a) (U1 a')
forall a b. (a -> b) -> a -> b
$ \U1 a
_ -> U1 a' -> f (U1 a')
forall (f :: * -> *) a. Applicative f => a -> f a
pure U1 a'
forall k (p :: k). U1 p
U1
  {-# INLINE unit #-}
instance Applicative f => GenericProductProfunctor (Star f) where
  mult :: forall (f :: * -> *) a (f' :: * -> *) a' (g :: * -> *)
       (g' :: * -> *).
Star f (f a) (f' a')
-> Star f (g a) (g' a') -> Star f ((:*:) f g a) ((:*:) f' g' a')
mult (Star f a -> f (f' a')
f) (Star g a -> f (g' a')
g) = ((:*:) f g a -> f ((:*:) f' g' a'))
-> Star f ((:*:) f g a) ((:*:) f' g' a')
forall {k} (f :: k -> *) d (c :: k). (d -> f c) -> Star f d c
Star (((:*:) f g a -> f ((:*:) f' g' a'))
 -> Star f ((:*:) f g a) ((:*:) f' g' a'))
-> ((:*:) f g a -> f ((:*:) f' g' a'))
-> Star f ((:*:) f g a) ((:*:) f' g' a')
forall a b. (a -> b) -> a -> b
$ \(f a
l :*: g a
r) -> f' a' -> g' a' -> (:*:) f' g' a'
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (f' a' -> g' a' -> (:*:) f' g' a')
-> f (f' a') -> f (g' a' -> (:*:) f' g' a')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a -> f (f' a')
f f a
l f (g' a' -> (:*:) f' g' a') -> f (g' a') -> f ((:*:) f' g' a')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> g a -> f (g' a')
g g a
r
  {-# INLINE mult #-}
instance Applicative f => GenericSumProfunctor (Star f) where
  plus :: forall (f :: * -> *) a (f' :: * -> *) a' (g :: * -> *)
       (g' :: * -> *).
Star f (f a) (f' a')
-> Star f (g a) (g' a') -> Star f ((:+:) f g a) ((:+:) f' g' a')
plus (Star f a -> f (f' a')
f) (Star g a -> f (g' a')
g) = ((:+:) f g a -> f ((:+:) f' g' a'))
-> Star f ((:+:) f g a) ((:+:) f' g' a')
forall {k} (f :: k -> *) d (c :: k). (d -> f c) -> Star f d c
Star (((:+:) f g a -> f ((:+:) f' g' a'))
 -> Star f ((:+:) f g a) ((:+:) f' g' a'))
-> ((:+:) f g a -> f ((:+:) f' g' a'))
-> Star f ((:+:) f g a) ((:+:) f' g' a')
forall a b. (a -> b) -> a -> b
$ (f a -> f ((:+:) f' g' a'))
-> (g a -> f ((:+:) f' g' a')) -> (:+:) f g a -> f ((:+:) f' g' a')
forall (f :: * -> *) a b (m :: Multiplicity) (g :: * -> *).
(f a %m -> b) -> (g a %m -> b) -> (:+:) f g a %m -> b
e1 ((f' a' -> (:+:) f' g' a') -> f (f' a') -> f ((:+:) f' g' a')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f' a' -> (:+:) f' g' a'
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (f (f' a') -> f ((:+:) f' g' a'))
-> (f a -> f (f' a')) -> f a -> f ((:+:) f' g' a')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> f (f' a')
f) ((g' a' -> (:+:) f' g' a') -> f (g' a') -> f ((:+:) f' g' a')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap g' a' -> (:+:) f' g' a'
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (f (g' a') -> f ((:+:) f' g' a'))
-> (g a -> f (g' a')) -> g a -> f ((:+:) f' g' a')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g a -> f (g' a')
g)
  {-# INLINE plus #-}
instance Functor f => GenericEmptyProfunctor (Star f) where
  zero :: forall a a'. Star f (V1 a) (V1 a')
zero = (V1 a -> f (V1 a')) -> Star f (V1 a) (V1 a')
forall {k} (f :: k -> *) d (c :: k). (d -> f c) -> Star f d c
Star V1 a -> f (V1 a')
\case
  {-# INLINE zero #-}
instance Applicative f => GenericConstantProfunctor (Star f) where
  identity :: forall c. Star f c c
identity = (c -> f c) -> Star f c c
forall {k} (f :: k -> *) d (c :: k). (d -> f c) -> Star f d c
Star c -> f c
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  {-# INLINE identity #-}

instance DL.Applicative f => GenericUnitProfunctor (Kleisli f) where
  unit :: forall a a'. Kleisli f (U1 a) (U1 a')
unit = (U1 a %1 -> f (U1 a')) -> Kleisli f (U1 a) (U1 a')
forall (m :: * -> *) a b. (a %1 -> m b) -> Kleisli m a b
Kleisli ((U1 a %1 -> f (U1 a')) -> Kleisli f (U1 a) (U1 a'))
-> (U1 a %1 -> f (U1 a')) -> Kleisli f (U1 a) (U1 a')
forall a b. (a -> b) -> a -> b
$ \U1 a
U1 -> U1 a' -> f (U1 a')
forall (f :: * -> *) a. Applicative f => a -> f a
DL.pure U1 a'
forall k (p :: k). U1 p
U1
  {-# INLINE unit #-}
instance DL.Applicative f => GenericProductProfunctor (Kleisli f) where
  mult :: forall (f :: * -> *) a (f' :: * -> *) a' (g :: * -> *)
       (g' :: * -> *).
Kleisli f (f a) (f' a')
-> Kleisli f (g a) (g' a')
-> Kleisli f ((:*:) f g a) ((:*:) f' g' a')
mult (Kleisli f a %1 -> f (f' a')
f) (Kleisli g a %1 -> f (g' a')
g) = ((:*:) f g a %1 -> f ((:*:) f' g' a'))
-> Kleisli f ((:*:) f g a) ((:*:) f' g' a')
forall (m :: * -> *) a b. (a %1 -> m b) -> Kleisli m a b
Kleisli (((:*:) f g a %1 -> f ((:*:) f' g' a'))
 -> Kleisli f ((:*:) f g a) ((:*:) f' g' a'))
-> ((:*:) f g a %1 -> f ((:*:) f' g' a'))
-> Kleisli f ((:*:) f g a) ((:*:) f' g' a')
forall a b. (a -> b) -> a -> b
$ \(f a
l :*: g a
r) -> f' a' %1 -> g' a' %1 -> (:*:) f' g' a'
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (f' a' %1 -> g' a' %1 -> (:*:) f' g' a')
-> f (f' a') %1 -> f (g' a' %1 -> (:*:) f' g' a')
forall (f :: * -> *) a b. Functor f => (a %1 -> b) -> f a %1 -> f b
DL.<$> f a %1 -> f (f' a')
f f a
l f (g' a' %1 -> (:*:) f' g' a')
%1 -> f (g' a') %1 -> f ((:*:) f' g' a')
forall (f :: * -> *) a b.
Applicative f =>
f (a %1 -> b) %1 -> f a %1 -> f b
DL.<*> g a %1 -> f (g' a')
g g a
r
  {-# INLINE mult #-}
instance DL.Applicative f => GenericSumProfunctor (Kleisli f) where
  plus :: forall (f :: * -> *) a (f' :: * -> *) a' (g :: * -> *)
       (g' :: * -> *).
Kleisli f (f a) (f' a')
-> Kleisli f (g a) (g' a')
-> Kleisli f ((:+:) f g a) ((:+:) f' g' a')
plus (Kleisli f a %1 -> f (f' a')
f) (Kleisli g a %1 -> f (g' a')
g) = ((:+:) f g a %1 -> f ((:+:) f' g' a'))
-> Kleisli f ((:+:) f g a) ((:+:) f' g' a')
forall (m :: * -> *) a b. (a %1 -> m b) -> Kleisli m a b
Kleisli (((:+:) f g a %1 -> f ((:+:) f' g' a'))
 -> Kleisli f ((:+:) f g a) ((:+:) f' g' a'))
-> ((:+:) f g a %1 -> f ((:+:) f' g' a'))
-> Kleisli f ((:+:) f g a) ((:+:) f' g' a')
forall a b. (a -> b) -> a -> b
$ (f a %1 -> f ((:+:) f' g' a'))
-> (g a %1 -> f ((:+:) f' g' a'))
-> (:+:) f g a
%1 -> f ((:+:) f' g' a')
forall (f :: * -> *) a b (m :: Multiplicity) (g :: * -> *).
(f a %m -> b) -> (g a %m -> b) -> (:+:) f g a %m -> b
e1 (\f a
x -> (f' a' %1 -> (:+:) f' g' a') -> f (f' a') %1 -> f ((:+:) f' g' a')
forall (f :: * -> *) a b. Functor f => (a %1 -> b) -> f a %1 -> f b
DL.fmap f' a' %1 -> (:+:) f' g' a'
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (f a %1 -> f (f' a')
f f a
x)) (\g a
x -> (g' a' %1 -> (:+:) f' g' a') -> f (g' a') %1 -> f ((:+:) f' g' a')
forall (f :: * -> *) a b. Functor f => (a %1 -> b) -> f a %1 -> f b
DL.fmap g' a' %1 -> (:+:) f' g' a'
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (g a %1 -> f (g' a')
g g a
x))
  {-# INLINE plus #-}
instance DL.Applicative f => GenericEmptyProfunctor (Kleisli f) where
  zero :: forall a a'. Kleisli f (V1 a) (V1 a')
zero = (V1 a %1 -> f (V1 a')) -> Kleisli f (V1 a) (V1 a')
forall (m :: * -> *) a b. (a %1 -> m b) -> Kleisli m a b
Kleisli V1 a %1 -> f (V1 a')
\case
  {-# INLINE zero #-}
instance CL.Applicative f => GenericConstantProfunctor (Kleisli f) where
  identity :: forall c. Kleisli f c c
identity = (c %1 -> f c) -> Kleisli f c c
forall (m :: * -> *) a b. (a %1 -> m b) -> Kleisli m a b
Kleisli c %1 -> f c
forall (f :: * -> *) a. Applicative f => a %1 -> f a
CL.pure
  {-# INLINE identity #-}

instance Functor f => Profunctor (Costar f) where dimap :: forall s a b t.
(s %1 -> a) -> (b %1 -> t) -> Costar f a b -> Costar f s t
dimap = (s %1 -> a) -> (b %1 -> t) -> Costar f a b -> Costar f s t
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a %1 -> b) -> (c %1 -> d) -> p b c -> p a d
dimapForget
instance Functor f => GenericUnitProfunctor (Costar f) where
  unit :: forall a a'. Costar f (U1 a) (U1 a')
unit = (f (U1 a) -> U1 a') -> Costar f (U1 a) (U1 a')
forall {k} (f :: k -> *) (d :: k) c. (f d -> c) -> Costar f d c
Costar ((f (U1 a) -> U1 a') -> Costar f (U1 a) (U1 a'))
-> (f (U1 a) -> U1 a') -> Costar f (U1 a) (U1 a')
forall a b. (a -> b) -> a -> b
$ U1 a' -> f (U1 a) -> U1 a'
forall a b. a -> b -> a
const U1 a'
forall k (p :: k). U1 p
U1
  {-# INLINE unit #-}
instance Functor f => GenericProductProfunctor (Costar f) where
  mult :: forall (f :: * -> *) a (f' :: * -> *) a' (g :: * -> *)
       (g' :: * -> *).
Costar f (f a) (f' a')
-> Costar f (g a) (g' a')
-> Costar f ((:*:) f g a) ((:*:) f' g' a')
mult (Costar f (f a) -> f' a'
f) (Costar f (g a) -> g' a'
g) = (f ((:*:) f g a) -> (:*:) f' g' a')
-> Costar f ((:*:) f g a) ((:*:) f' g' a')
forall {k} (f :: k -> *) (d :: k) c. (f d -> c) -> Costar f d c
Costar ((f ((:*:) f g a) -> (:*:) f' g' a')
 -> Costar f ((:*:) f g a) ((:*:) f' g' a'))
-> (f ((:*:) f g a) -> (:*:) f' g' a')
-> Costar f ((:*:) f g a) ((:*:) f' g' a')
forall a b. (a -> b) -> a -> b
$ \f ((:*:) f g a)
lr -> f (f a) -> f' a'
f ((:*:) f g a -> f a
forall (f :: * -> *) (g :: * -> *) a. (:*:) f g a -> f a
fst1 ((:*:) f g a -> f a) -> f ((:*:) f g a) -> f (f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f ((:*:) f g a)
lr) f' a' -> g' a' -> (:*:) f' g' a'
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: f (g a) -> g' a'
g ((:*:) f g a -> g a
forall (f :: * -> *) (g :: * -> *) a. (:*:) f g a -> g a
snd1 ((:*:) f g a -> g a) -> f ((:*:) f g a) -> f (g a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f ((:*:) f g a)
lr)
  {-# INLINE mult #-}

instance (Functor f, Applicative g, P.Profunctor p) => Profunctor (Biff p f g) where dimap :: forall s a b t.
(s %1 -> a) -> (b %1 -> t) -> Biff p f g a b -> Biff p f g s t
dimap = (s %1 -> a) -> (b %1 -> t) -> Biff p f g a b -> Biff p f g s t
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a %1 -> b) -> (c %1 -> d) -> p b c -> p a d
dimapForget
instance (Functor f, Applicative g, P.Profunctor p, GenericUnitProfunctor p) => GenericUnitProfunctor (Biff p f g) where
  unit :: forall a a'. Biff p f g (U1 a) (U1 a')
unit = p (f (U1 a)) (g (U1 a')) -> Biff p f g (U1 a) (U1 a')
forall {k} {k1} {k2} {k3} (p :: k -> k1 -> *) (f :: k2 -> k)
       (g :: k3 -> k1) (a :: k2) (b :: k3).
p (f a) (g b) -> Biff p f g a b
Biff (p (f (U1 a)) (g (U1 a')) -> Biff p f g (U1 a) (U1 a'))
-> p (f (U1 a)) (g (U1 a')) -> Biff p f g (U1 a) (U1 a')
forall a b. (a -> b) -> a -> b
$ (f (U1 a) -> U1 Any)
-> (U1 a' -> g (U1 a'))
-> p (U1 Any) (U1 a')
-> p (f (U1 a)) (g (U1 a'))
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
P.dimap (U1 Any -> f (U1 a) -> U1 Any
forall a b. a -> b -> a
const U1 Any
forall k (p :: k). U1 p
U1) U1 a' -> g (U1 a')
forall (f :: * -> *) a. Applicative f => a -> f a
pure p (U1 Any) (U1 a')
forall (p :: * -> * -> *) a a'.
GenericUnitProfunctor p =>
p (U1 a) (U1 a')
unit
  {-# INLINE unit #-}
instance (Functor f, Applicative g, P.Profunctor p, GenericProductProfunctor p) => GenericProductProfunctor (Biff p f g) where
  mult :: forall (f :: * -> *) a (f' :: * -> *) a' (g :: * -> *)
       (g' :: * -> *).
Biff p f g (f a) (f' a')
-> Biff p f g (g a) (g' a')
-> Biff p f g ((:*:) f g a) ((:*:) f' g' a')
mult (Biff p (f (f a)) (g (f' a'))
f) (Biff p (f (g a)) (g (g' a'))
g) = p (f ((:*:) f g a)) (g ((:*:) f' g' a'))
-> Biff p f g ((:*:) f g a) ((:*:) f' g' a')
forall {k} {k1} {k2} {k3} (p :: k -> k1 -> *) (f :: k2 -> k)
       (g :: k3 -> k1) (a :: k2) (b :: k3).
p (f a) (g b) -> Biff p f g a b
Biff (p (f ((:*:) f g a)) (g ((:*:) f' g' a'))
 -> Biff p f g ((:*:) f g a) ((:*:) f' g' a'))
-> p (f ((:*:) f g a)) (g ((:*:) f' g' a'))
-> Biff p f g ((:*:) f g a) ((:*:) f' g' a')
forall a b. (a -> b) -> a -> b
$ (f ((:*:) f g a) -> (:*:) (Compose f f) (Compose f g) a)
-> ((:*:) (Compose g f') (Compose g g') a' -> g ((:*:) f' g' a'))
-> p ((:*:) (Compose f f) (Compose f g) a)
     ((:*:) (Compose g f') (Compose g g') a')
-> p (f ((:*:) f g a)) (g ((:*:) f' g' a'))
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
P.dimap
    ((Compose f f a
 -> Compose f g a -> (:*:) (Compose f f) (Compose f g) a)
-> (f ((:*:) f g a) -> Compose f f a)
-> (f ((:*:) f g a) -> Compose f g a)
-> f ((:*:) f g a)
-> (:*:) (Compose f f) (Compose f g) a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Compose f f a
-> Compose f g a -> (:*:) (Compose f f) (Compose f g) a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (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 (f (f a) -> Compose f f a)
-> (f ((:*:) f g a) -> f (f a)) -> f ((:*:) f g a) -> Compose f f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((:*:) f g a -> f a) -> f ((:*:) f g a) -> f (f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (:*:) f g a -> f a
forall (f :: * -> *) (g :: * -> *) a. (:*:) f g a -> f a
fst1) (f (g a) -> Compose f g a
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (f (g a) -> Compose f g a)
-> (f ((:*:) f g a) -> f (g a)) -> f ((:*:) f g a) -> Compose f g a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((:*:) f g a -> g a) -> f ((:*:) f g a) -> f (g a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (:*:) f g a -> g a
forall (f :: * -> *) (g :: * -> *) a. (:*:) f g a -> g a
snd1))
    (\(Compose g (f' a')
l :*: Compose g (g' a')
r) -> (f' a' -> g' a' -> (:*:) f' g' a')
-> g (f' a') -> g (g' a') -> g ((:*:) f' g' a')
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 f' a' -> g' a' -> (:*:) f' g' a'
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) g (f' a')
l g (g' a')
r)
    (p (Compose f f a) (Compose g f' a')
-> p (Compose f g a) (Compose g g' a')
-> p ((:*:) (Compose f f) (Compose f g) a)
     ((:*:) (Compose g f') (Compose g g') a')
forall (p :: * -> * -> *) (f :: * -> *) a (f' :: * -> *) a'
       (g :: * -> *) (g' :: * -> *).
GenericProductProfunctor p =>
p (f a) (f' a')
-> p (g a) (g' a') -> p ((:*:) f g a) ((:*:) f' g' a')
mult ((Compose f f a -> f (f a))
-> (g (f' a') -> Compose g f' a')
-> p (f (f a)) (g (f' a'))
-> p (Compose f f a) (Compose g f' a')
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
P.dimap Compose f f a -> f (f a)
forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose g (f' a') -> Compose g f' a'
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose p (f (f a)) (g (f' a'))
f) ((Compose f g a -> f (g a))
-> (g (g' a') -> Compose g g' a')
-> p (f (g a)) (g (g' a'))
-> p (Compose f g a) (Compose g g' a')
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
P.dimap Compose f g a -> f (g a)
forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose g (g' a') -> Compose g g' a'
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose p (f (g a)) (g (g' a'))
g))
  {-# INLINE mult #-}

instance Functor f => Profunctor (Joker f) where dimap :: forall s a b t.
(s %1 -> a) -> (b %1 -> t) -> Joker f a b -> Joker f s t
dimap = (s %1 -> a) -> (b %1 -> t) -> Joker f a b -> Joker f s t
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a %1 -> b) -> (c %1 -> d) -> p b c -> p a d
dimapForget
instance Applicative f => GenericUnitProfunctor (Joker f) where
  unit :: forall a a'. Joker f (U1 a) (U1 a')
unit = f (U1 a') -> Joker f (U1 a) (U1 a')
forall {k} {k1} (g :: k -> *) (a :: k1) (b :: k).
g b -> Joker g a b
Joker (f (U1 a') -> Joker f (U1 a) (U1 a'))
-> f (U1 a') -> Joker f (U1 a) (U1 a')
forall a b. (a -> b) -> a -> b
$ U1 a' -> f (U1 a')
forall (f :: * -> *) a. Applicative f => a -> f a
pure U1 a'
forall k (p :: k). U1 p
U1
  {-# INLINE unit #-}
instance Applicative f => GenericProductProfunctor (Joker f) where
  mult :: forall (f :: * -> *) a (f' :: * -> *) a' (g :: * -> *)
       (g' :: * -> *).
Joker f (f a) (f' a')
-> Joker f (g a) (g' a') -> Joker f ((:*:) f g a) ((:*:) f' g' a')
mult (Joker f (f' a')
l) (Joker f (g' a')
r) = f ((:*:) f' g' a') -> Joker f ((:*:) f g a) ((:*:) f' g' a')
forall {k} {k1} (g :: k -> *) (a :: k1) (b :: k).
g b -> Joker g a b
Joker (f ((:*:) f' g' a') -> Joker f ((:*:) f g a) ((:*:) f' g' a'))
-> f ((:*:) f' g' a') -> Joker f ((:*:) f g a) ((:*:) f' g' a')
forall a b. (a -> b) -> a -> b
$ f' a' -> g' a' -> (:*:) f' g' a'
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (f' a' -> g' a' -> (:*:) f' g' a')
-> f (f' a') -> f (g' a' -> (:*:) f' g' a')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (f' a')
l f (g' a' -> (:*:) f' g' a') -> f (g' a') -> f ((:*:) f' g' a')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f (g' a')
r
  {-# INLINE mult #-}
instance Alternative f => GenericSumProfunctor (Joker f) where
  plus :: forall (f :: * -> *) a (f' :: * -> *) a' (g :: * -> *)
       (g' :: * -> *).
Joker f (f a) (f' a')
-> Joker f (g a) (g' a') -> Joker f ((:+:) f g a) ((:+:) f' g' a')
plus (Joker f (f' a')
l) (Joker f (g' a')
r) = f ((:+:) f' g' a') -> Joker f ((:+:) f g a) ((:+:) f' g' a')
forall {k} {k1} (g :: k -> *) (a :: k1) (b :: k).
g b -> Joker g a b
Joker (f ((:+:) f' g' a') -> Joker f ((:+:) f g a) ((:+:) f' g' a'))
-> f ((:+:) f' g' a') -> Joker f ((:+:) f g a) ((:+:) f' g' a')
forall a b. (a -> b) -> a -> b
$ f' a' -> (:+:) f' g' a'
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (f' a' -> (:+:) f' g' a') -> f (f' a') -> f ((:+:) f' g' a')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (f' a')
l f ((:+:) f' g' a') -> f ((:+:) f' g' a') -> f ((:+:) f' g' a')
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> g' a' -> (:+:) f' g' a'
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (g' a' -> (:+:) f' g' a') -> f (g' a') -> f ((:+:) f' g' a')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (g' a')
r
  {-# INLINE plus #-}
instance Alternative f => GenericEmptyProfunctor (Joker f) where
  zero :: forall a a'. Joker f (V1 a) (V1 a')
zero = f (V1 a') -> Joker f (V1 a) (V1 a')
forall {k} {k1} (g :: k -> *) (a :: k1) (b :: k).
g b -> Joker g a b
Joker f (V1 a')
forall (f :: * -> *) a. Alternative f => f a
empty
  {-# INLINE zero #-}
instance Alternative f => GenericConstantProfunctor (Joker f) where
  identity :: forall c. Joker f c c
identity = f c -> Joker f c c
forall {k} {k1} (g :: k -> *) (a :: k1) (b :: k).
g b -> Joker g a b
Joker f c
forall (f :: * -> *) a. Alternative f => f a
empty
  {-# INLINE identity #-}

instance Contravariant f => Profunctor (Clown f) where dimap :: forall s a b t.
(s %1 -> a) -> (b %1 -> t) -> Clown f a b -> Clown f s t
dimap = (s %1 -> a) -> (b %1 -> t) -> Clown f a b -> Clown f s t
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a %1 -> b) -> (c %1 -> d) -> p b c -> p a d
dimapForget
instance Divisible f => GenericUnitProfunctor (Clown f) where
  unit :: forall a a'. Clown f (U1 a) (U1 a')
unit = f (U1 a) -> Clown f (U1 a) (U1 a')
forall {k} {k1} (f :: k -> *) (a :: k) (b :: k1).
f a -> Clown f a b
Clown f (U1 a)
forall (f :: * -> *) a. Divisible f => f a
conquer
  {-# INLINE unit #-}
instance Divisible f => GenericProductProfunctor (Clown f) where
  mult :: forall (f :: * -> *) a (f' :: * -> *) a' (g :: * -> *)
       (g' :: * -> *).
Clown f (f a) (f' a')
-> Clown f (g a) (g' a') -> Clown f ((:*:) f g a) ((:*:) f' g' a')
mult (Clown f (f a)
f) (Clown f (g a)
g) = f ((:*:) f g a) -> Clown f ((:*:) f g a) ((:*:) f' g' a')
forall {k} {k1} (f :: k -> *) (a :: k) (b :: k1).
f a -> Clown f a b
Clown (f ((:*:) f g a) -> Clown f ((:*:) f g a) ((:*:) f' g' a'))
-> f ((:*:) f g a) -> Clown f ((:*:) f g a) ((:*:) f' g' a')
forall a b. (a -> b) -> a -> b
$ ((:*:) f g a -> (f a, g a))
-> f (f a) -> f (g a) -> f ((:*:) f g a)
forall (f :: * -> *) a b c.
Divisible f =>
(a -> (b, c)) -> f b -> f c -> f a
divide (\(f a
l :*: g a
r) -> (f a
l, g a
r)) f (f a)
f f (g a)
g
  {-# INLINE mult #-}
instance Decidable f => GenericSumProfunctor (Clown f) where
  plus :: forall (f :: * -> *) a (f' :: * -> *) a' (g :: * -> *)
       (g' :: * -> *).
Clown f (f a) (f' a')
-> Clown f (g a) (g' a') -> Clown f ((:+:) f g a) ((:+:) f' g' a')
plus (Clown f (f a)
f) (Clown f (g a)
g) = f ((:+:) f g a) -> Clown f ((:+:) f g a) ((:+:) f' g' a')
forall {k} {k1} (f :: k -> *) (a :: k) (b :: k1).
f a -> Clown f a b
Clown (f ((:+:) f g a) -> Clown f ((:+:) f g a) ((:+:) f' g' a'))
-> f ((:+:) f g a) -> Clown f ((:+:) f g a) ((:+:) f' g' a')
forall a b. (a -> b) -> a -> b
$ ((:+:) f g a -> Either (f a) (g a))
-> f (f a) -> f (g a) -> f ((:+:) f g a)
forall (f :: * -> *) a b c.
Decidable f =>
(a -> Either b c) -> f b -> f c -> f a
choose ((f a -> Either (f a) (g a))
-> (g a -> Either (f a) (g a)) -> (:+:) f g a -> Either (f a) (g a)
forall (f :: * -> *) a b (m :: Multiplicity) (g :: * -> *).
(f a %m -> b) -> (g a %m -> b) -> (:+:) f g a %m -> b
e1 f a -> Either (f a) (g a)
forall a b. a -> Either a b
Left g a -> Either (f a) (g a)
forall a b. b -> Either a b
Right) f (f a)
f f (g a)
g
  {-# INLINE plus #-}
instance Decidable f => GenericEmptyProfunctor (Clown f) where
  zero :: forall a a'. Clown f (V1 a) (V1 a')
zero = f (V1 a) -> Clown f (V1 a) (V1 a')
forall {k} {k1} (f :: k -> *) (a :: k) (b :: k1).
f a -> Clown f a b
Clown (f (V1 a) -> Clown f (V1 a) (V1 a'))
-> f (V1 a) -> Clown f (V1 a) (V1 a')
forall a b. (a -> b) -> a -> b
$ (V1 a -> Void) -> f (V1 a)
forall (f :: * -> *) a. Decidable f => (a -> Void) -> f a
lose V1 a -> Void
\case
  {-# INLINE zero #-}
instance Decidable f => GenericConstantProfunctor (Clown f) where
  identity :: forall c. Clown f c c
identity = f c -> Clown f c c
forall {k} {k1} (f :: k -> *) (a :: k) (b :: k1).
f a -> Clown f a b
Clown f c
forall (f :: * -> *) a. Divisible f => f a
conquer
  {-# INLINE identity #-}

instance (Profunctor p, Profunctor q) => Profunctor (Product p q) where
  dimap :: forall s a b t.
(s %1 -> a) -> (b %1 -> t) -> Product p q a b -> Product p q s t
dimap s %1 -> a
f b %1 -> t
g (Pair p a b
l q a b
r) = p s t -> q s t -> Product p q s t
forall {k} {k1} (f :: k -> k1 -> *) (g :: k -> k1 -> *) (a :: k)
       (b :: k1).
f a b -> g a b -> Product f g a b
Pair ((s %1 -> a) -> (b %1 -> t) -> p a b -> p s t
forall (arr :: * -> * -> *) s a b t.
Profunctor arr =>
(s %1 -> a) -> (b %1 -> t) -> arr a b -> arr s t
dimap s %1 -> a
f b %1 -> t
g p a b
l) ((s %1 -> a) -> (b %1 -> t) -> q a b -> q s t
forall (arr :: * -> * -> *) s a b t.
Profunctor arr =>
(s %1 -> a) -> (b %1 -> t) -> arr a b -> arr s t
dimap s %1 -> a
f b %1 -> t
g q a b
r)
instance (GenericUnitProfunctor p, GenericUnitProfunctor q) => GenericUnitProfunctor (Product p q) where
  unit :: forall a a'. Product p q (U1 a) (U1 a')
unit = p (U1 a) (U1 a') -> q (U1 a) (U1 a') -> Product p q (U1 a) (U1 a')
forall {k} {k1} (f :: k -> k1 -> *) (g :: k -> k1 -> *) (a :: k)
       (b :: k1).
f a b -> g a b -> Product f g a b
Pair p (U1 a) (U1 a')
forall (p :: * -> * -> *) a a'.
GenericUnitProfunctor p =>
p (U1 a) (U1 a')
unit q (U1 a) (U1 a')
forall (p :: * -> * -> *) a a'.
GenericUnitProfunctor p =>
p (U1 a) (U1 a')
unit
  {-# INLINE unit #-}
instance (GenericProductProfunctor p, GenericProductProfunctor q) => GenericProductProfunctor (Product p q) where
  mult :: forall (f :: * -> *) a (f' :: * -> *) a' (g :: * -> *)
       (g' :: * -> *).
Product p q (f a) (f' a')
-> Product p q (g a) (g' a')
-> Product p q ((:*:) f g a) ((:*:) f' g' a')
mult (Pair p (f a) (f' a')
l1 q (f a) (f' a')
r1) (Pair p (g a) (g' a')
l2 q (g a) (g' a')
r2) = p ((:*:) f g a) ((:*:) f' g' a')
-> q ((:*:) f g a) ((:*:) f' g' a')
-> Product p q ((:*:) f g a) ((:*:) f' g' a')
forall {k} {k1} (f :: k -> k1 -> *) (g :: k -> k1 -> *) (a :: k)
       (b :: k1).
f a b -> g a b -> Product f g a b
Pair (p (f a) (f' a')
-> p (g a) (g' a') -> p ((:*:) f g a) ((:*:) f' g' a')
forall (p :: * -> * -> *) (f :: * -> *) a (f' :: * -> *) a'
       (g :: * -> *) (g' :: * -> *).
GenericProductProfunctor p =>
p (f a) (f' a')
-> p (g a) (g' a') -> p ((:*:) f g a) ((:*:) f' g' a')
mult p (f a) (f' a')
l1 p (g a) (g' a')
l2) (q (f a) (f' a')
-> q (g a) (g' a') -> q ((:*:) f g a) ((:*:) f' g' a')
forall (p :: * -> * -> *) (f :: * -> *) a (f' :: * -> *) a'
       (g :: * -> *) (g' :: * -> *).
GenericProductProfunctor p =>
p (f a) (f' a')
-> p (g a) (g' a') -> p ((:*:) f g a) ((:*:) f' g' a')
mult q (f a) (f' a')
r1 q (g a) (g' a')
r2)
  {-# INLINE mult #-}
instance (GenericSumProfunctor p, GenericSumProfunctor q) => GenericSumProfunctor (Product p q) where
  plus :: forall (f :: * -> *) a (f' :: * -> *) a' (g :: * -> *)
       (g' :: * -> *).
Product p q (f a) (f' a')
-> Product p q (g a) (g' a')
-> Product p q ((:+:) f g a) ((:+:) f' g' a')
plus (Pair p (f a) (f' a')
l1 q (f a) (f' a')
r1) (Pair p (g a) (g' a')
l2 q (g a) (g' a')
r2) = p ((:+:) f g a) ((:+:) f' g' a')
-> q ((:+:) f g a) ((:+:) f' g' a')
-> Product p q ((:+:) f g a) ((:+:) f' g' a')
forall {k} {k1} (f :: k -> k1 -> *) (g :: k -> k1 -> *) (a :: k)
       (b :: k1).
f a b -> g a b -> Product f g a b
Pair (p (f a) (f' a')
-> p (g a) (g' a') -> p ((:+:) f g a) ((:+:) f' g' a')
forall (p :: * -> * -> *) (f :: * -> *) a (f' :: * -> *) a'
       (g :: * -> *) (g' :: * -> *).
GenericSumProfunctor p =>
p (f a) (f' a')
-> p (g a) (g' a') -> p ((:+:) f g a) ((:+:) f' g' a')
plus p (f a) (f' a')
l1 p (g a) (g' a')
l2) (q (f a) (f' a')
-> q (g a) (g' a') -> q ((:+:) f g a) ((:+:) f' g' a')
forall (p :: * -> * -> *) (f :: * -> *) a (f' :: * -> *) a'
       (g :: * -> *) (g' :: * -> *).
GenericSumProfunctor p =>
p (f a) (f' a')
-> p (g a) (g' a') -> p ((:+:) f g a) ((:+:) f' g' a')
plus q (f a) (f' a')
r1 q (g a) (g' a')
r2)
  {-# INLINE plus #-}
instance (GenericEmptyProfunctor p, GenericEmptyProfunctor q) => GenericEmptyProfunctor (Product p q) where
  zero :: forall a a'. Product p q (V1 a) (V1 a')
zero = p (V1 a) (V1 a') -> q (V1 a) (V1 a') -> Product p q (V1 a) (V1 a')
forall {k} {k1} (f :: k -> k1 -> *) (g :: k -> k1 -> *) (a :: k)
       (b :: k1).
f a b -> g a b -> Product f g a b
Pair p (V1 a) (V1 a')
forall (p :: * -> * -> *) a a'.
GenericEmptyProfunctor p =>
p (V1 a) (V1 a')
zero q (V1 a) (V1 a')
forall (p :: * -> * -> *) a a'.
GenericEmptyProfunctor p =>
p (V1 a) (V1 a')
zero
  {-# INLINE zero #-}
instance (GenericConstantProfunctor p, GenericConstantProfunctor q) => GenericConstantProfunctor (Product p q) where
  identity :: forall c. Product p q c c
identity = p c c -> q c c -> Product p q c c
forall {k} {k1} (f :: k -> k1 -> *) (g :: k -> k1 -> *) (a :: k)
       (b :: k1).
f a b -> g a b -> Product f g a b
Pair p c c
forall (p :: * -> * -> *) c. GenericConstantProfunctor p => p c c
identity q c c
forall (p :: * -> * -> *) c. GenericConstantProfunctor p => p c c
identity
  {-# INLINE identity #-}

instance (Applicative f, Profunctor p) => Profunctor (Tannen f p) where
  dimap :: forall s a b t.
(s %1 -> a) -> (b %1 -> t) -> Tannen f p a b -> Tannen f p s t
dimap s %1 -> a
f b %1 -> t
g (Tannen f (p a b)
p) = f (p s t) -> Tannen f p s t
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 s t) -> Tannen f p s t) -> f (p s t) -> Tannen f p s t
forall a b. (a -> b) -> a -> b
$ (s %1 -> a) -> (b %1 -> t) -> p a b -> p s t
forall (arr :: * -> * -> *) s a b t.
Profunctor arr =>
(s %1 -> a) -> (b %1 -> t) -> arr a b -> arr s t
dimap s %1 -> a
f b %1 -> t
g (p a b -> p s t) -> f (p a b) -> f (p s t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (p a b)
p
instance (Applicative f, GenericUnitProfunctor p) => GenericUnitProfunctor (Tannen f p) where
  unit :: forall a a'. Tannen f p (U1 a) (U1 a')
unit = f (p (U1 a) (U1 a')) -> Tannen f p (U1 a) (U1 a')
forall {k} {k1} {k2} (f :: k -> *) (p :: k1 -> k2 -> k) (a :: k1)
       (b :: k2).
f (p a b) -> Tannen f p a b
Tannen (p (U1 a) (U1 a') -> f (p (U1 a) (U1 a'))
forall (f :: * -> *) a. Applicative f => a -> f a
pure p (U1 a) (U1 a')
forall (p :: * -> * -> *) a a'.
GenericUnitProfunctor p =>
p (U1 a) (U1 a')
unit)
  {-# INLINE unit #-}
instance (Applicative f, GenericProductProfunctor p) => GenericProductProfunctor (Tannen f p) where
  mult :: forall (f :: * -> *) a (f' :: * -> *) a' (g :: * -> *)
       (g' :: * -> *).
Tannen f p (f a) (f' a')
-> Tannen f p (g a) (g' a')
-> Tannen f p ((:*:) f g a) ((:*:) f' g' a')
mult (Tannen f (p (f a) (f' a'))
l) (Tannen f (p (g a) (g' a'))
r) = f (p ((:*:) f g a) ((:*:) f' g' a'))
-> Tannen f p ((:*:) f g a) ((:*:) f' g' a')
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 g a) ((:*:) f' g' a'))
 -> Tannen f p ((:*:) f g a) ((:*:) f' g' a'))
-> f (p ((:*:) f g a) ((:*:) f' g' a'))
-> Tannen f p ((:*:) f g a) ((:*:) f' g' a')
forall a b. (a -> b) -> a -> b
$ (p (f a) (f' a')
 -> p (g a) (g' a') -> p ((:*:) f g a) ((:*:) f' g' a'))
-> f (p (f a) (f' a'))
-> f (p (g a) (g' a'))
-> f (p ((:*:) f g a) ((:*:) f' g' a'))
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 p (f a) (f' a')
-> p (g a) (g' a') -> p ((:*:) f g a) ((:*:) f' g' a')
forall (p :: * -> * -> *) (f :: * -> *) a (f' :: * -> *) a'
       (g :: * -> *) (g' :: * -> *).
GenericProductProfunctor p =>
p (f a) (f' a')
-> p (g a) (g' a') -> p ((:*:) f g a) ((:*:) f' g' a')
mult f (p (f a) (f' a'))
l f (p (g a) (g' a'))
r
  {-# INLINE mult #-}
instance (Applicative f, GenericSumProfunctor p) => GenericSumProfunctor (Tannen f p) where
  plus :: forall (f :: * -> *) a (f' :: * -> *) a' (g :: * -> *)
       (g' :: * -> *).
Tannen f p (f a) (f' a')
-> Tannen f p (g a) (g' a')
-> Tannen f p ((:+:) f g a) ((:+:) f' g' a')
plus (Tannen f (p (f a) (f' a'))
l) (Tannen f (p (g a) (g' a'))
r) = f (p ((:+:) f g a) ((:+:) f' g' a'))
-> Tannen f p ((:+:) f g a) ((:+:) f' g' a')
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 g a) ((:+:) f' g' a'))
 -> Tannen f p ((:+:) f g a) ((:+:) f' g' a'))
-> f (p ((:+:) f g a) ((:+:) f' g' a'))
-> Tannen f p ((:+:) f g a) ((:+:) f' g' a')
forall a b. (a -> b) -> a -> b
$ (p (f a) (f' a')
 -> p (g a) (g' a') -> p ((:+:) f g a) ((:+:) f' g' a'))
-> f (p (f a) (f' a'))
-> f (p (g a) (g' a'))
-> f (p ((:+:) f g a) ((:+:) f' g' a'))
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 p (f a) (f' a')
-> p (g a) (g' a') -> p ((:+:) f g a) ((:+:) f' g' a')
forall (p :: * -> * -> *) (f :: * -> *) a (f' :: * -> *) a'
       (g :: * -> *) (g' :: * -> *).
GenericSumProfunctor p =>
p (f a) (f' a')
-> p (g a) (g' a') -> p ((:+:) f g a) ((:+:) f' g' a')
plus f (p (f a) (f' a'))
l f (p (g a) (g' a'))
r
  {-# INLINE plus #-}
instance (Applicative f, GenericEmptyProfunctor p) => GenericEmptyProfunctor (Tannen f p) where
  zero :: forall a a'. Tannen f p (V1 a) (V1 a')
zero = f (p (V1 a) (V1 a')) -> Tannen f p (V1 a) (V1 a')
forall {k} {k1} {k2} (f :: k -> *) (p :: k1 -> k2 -> k) (a :: k1)
       (b :: k2).
f (p a b) -> Tannen f p a b
Tannen (p (V1 a) (V1 a') -> f (p (V1 a) (V1 a'))
forall (f :: * -> *) a. Applicative f => a -> f a
pure p (V1 a) (V1 a')
forall (p :: * -> * -> *) a a'.
GenericEmptyProfunctor p =>
p (V1 a) (V1 a')
zero)
  {-# INLINE zero #-}
instance (Applicative f, GenericConstantProfunctor p) => GenericConstantProfunctor (Tannen f p) where
  identity :: forall c. Tannen f p c c
identity = f (p c c) -> Tannen f p c c
forall {k} {k1} {k2} (f :: k -> *) (p :: k1 -> k2 -> k) (a :: k1)
       (b :: k2).
f (p a b) -> Tannen f p a b
Tannen (p c c -> f (p c c)
forall (f :: * -> *) a. Applicative f => a -> f a
pure p c c
forall (p :: * -> * -> *) c. GenericConstantProfunctor p => p c c
identity)
  {-# INLINE identity #-}


newtype Zip f a b = Zip { forall (f :: * -> *) a b. Zip f a b -> a -> a -> f b
runZip :: a -> a -> f b }
instance Functor f => Profunctor (Zip f) where
  dimap :: forall s a b t.
(s %1 -> a) -> (b %1 -> t) -> Zip f a b -> Zip f s t
dimap s %1 -> a
f b %1 -> t
g (Zip a -> a -> f b
h) = (s -> s -> f t) -> Zip f s t
forall (f :: * -> *) a b. (a -> a -> f b) -> Zip f a b
Zip ((s -> s -> f t) -> Zip f s t) -> (s -> s -> f t) -> Zip f s t
forall a b. (a -> b) -> a -> b
$ \s
a1 s
a2 -> (b -> t) -> f b -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b %1 -> t) %1 -> b -> t
forall a b. (a %1 -> b) %1 -> a -> b
forget b %1 -> t
g) (a -> a -> f b
h (s %1 -> a
f s
a1) (s %1 -> a
f s
a2))
  {-# INLINE dimap #-}
instance Applicative f => GenericUnitProfunctor (Zip f) where
  unit :: forall a a'. Zip f (U1 a) (U1 a')
unit = (U1 a -> U1 a -> f (U1 a')) -> Zip f (U1 a) (U1 a')
forall (f :: * -> *) a b. (a -> a -> f b) -> Zip f a b
Zip ((U1 a -> U1 a -> f (U1 a')) -> Zip f (U1 a) (U1 a'))
-> (U1 a -> U1 a -> f (U1 a')) -> Zip f (U1 a) (U1 a')
forall a b. (a -> b) -> a -> b
$ \U1 a
_ U1 a
_ -> U1 a' -> f (U1 a')
forall (f :: * -> *) a. Applicative f => a -> f a
pure U1 a'
forall k (p :: k). U1 p
U1
  {-# INLINE unit #-}
instance Applicative f => GenericProductProfunctor (Zip f) where
  mult :: forall (f :: * -> *) a (f' :: * -> *) a' (g :: * -> *)
       (g' :: * -> *).
Zip f (f a) (f' a')
-> Zip f (g a) (g' a') -> Zip f ((:*:) f g a) ((:*:) f' g' a')
mult (Zip f a -> f a -> f (f' a')
f) (Zip g a -> g a -> f (g' a')
g) = ((:*:) f g a -> (:*:) f g a -> f ((:*:) f' g' a'))
-> Zip f ((:*:) f g a) ((:*:) f' g' a')
forall (f :: * -> *) a b. (a -> a -> f b) -> Zip f a b
Zip (((:*:) f g a -> (:*:) f g a -> f ((:*:) f' g' a'))
 -> Zip f ((:*:) f g a) ((:*:) f' g' a'))
-> ((:*:) f g a -> (:*:) f g a -> f ((:*:) f' g' a'))
-> Zip f ((:*:) f g a) ((:*:) f' g' a')
forall a b. (a -> b) -> a -> b
$ \(f a
al :*: g a
ar) (f a
bl :*: g a
br) -> f' a' -> g' a' -> (:*:) f' g' a'
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (f' a' -> g' a' -> (:*:) f' g' a')
-> f (f' a') -> f (g' a' -> (:*:) f' g' a')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a -> f a -> f (f' a')
f f a
al f a
bl f (g' a' -> (:*:) f' g' a') -> f (g' a') -> f ((:*:) f' g' a')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> g a -> g a -> f (g' a')
g g a
ar g a
br
  {-# INLINE mult #-}
instance Alternative f => GenericSumProfunctor (Zip f) where
  plus :: forall (f :: * -> *) a (f' :: * -> *) a' (g :: * -> *)
       (g' :: * -> *).
Zip f (f a) (f' a')
-> Zip f (g a) (g' a') -> Zip f ((:+:) f g a) ((:+:) f' g' a')
plus (Zip f a -> f a -> f (f' a')
f) (Zip g a -> g a -> f (g' a')
g) = ((:+:) f g a -> (:+:) f g a -> f ((:+:) f' g' a'))
-> Zip f ((:+:) f g a) ((:+:) f' g' a')
forall (f :: * -> *) a b. (a -> a -> f b) -> Zip f a b
Zip (:+:) f g a -> (:+:) f g a -> f ((:+:) f' g' a')
h where
    h :: (:+:) f g a -> (:+:) f g a -> f ((:+:) f' g' a')
h (L1 f a
a) (L1 f a
b) = (f' a' -> (:+:) f' g' a') -> f (f' a') -> f ((:+:) f' g' a')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f' a' -> (:+:) f' g' a'
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (f a -> f a -> f (f' a')
f f a
a f a
b)
    h (R1 g a
a) (R1 g a
b) = (g' a' -> (:+:) f' g' a') -> f (g' a') -> f ((:+:) f' g' a')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap g' a' -> (:+:) f' g' a'
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (g a -> g a -> f (g' a')
g g a
a g a
b)
    h (:+:) f g a
_ (:+:) f g a
_ = f ((:+:) f' g' a')
forall (f :: * -> *) a. Alternative f => f a
empty
  {-# INLINE plus #-}
instance Functor f => GenericEmptyProfunctor (Zip f) where
  zero :: forall a a'. Zip f (V1 a) (V1 a')
zero = (V1 a -> V1 a -> f (V1 a')) -> Zip f (V1 a) (V1 a')
forall (f :: * -> *) a b. (a -> a -> f b) -> Zip f a b
Zip V1 a -> V1 a -> f (V1 a')
\case
  {-# INLINE zero #-}
instance Alternative f => GenericConstantProfunctor (Zip f) where
  identity :: forall c. Zip f c c
identity = (c -> c -> f c) -> Zip f c c
forall (f :: * -> *) a b. (a -> a -> f b) -> Zip f a b
Zip ((c -> c -> f c) -> Zip f c c) -> (c -> c -> f c) -> Zip f c c
forall a b. (a -> b) -> a -> b
$ \c
_ c
_ -> f c
forall (f :: * -> *) a. Alternative f => f a
empty
  {-# INLINE identity #-}


e1 :: (f a %m-> b) -> (g a %m-> b) -> (f :+: g) a %m-> b
e1 :: forall (f :: * -> *) a b (m :: Multiplicity) (g :: * -> *).
(f a %m -> b) -> (g a %m -> b) -> (:+:) f g a %m -> b
e1 f a %m -> b
f g a %m -> b
_ (L1 f a
l) = f a %m -> b
f f a
l
e1 f a %m -> b
_ g a %m -> b
f (R1 g a
r) = g a %m -> b
f g a
r
{-# INLINE e1 #-}

fst1 :: (f :*: g) a -> f a
fst1 :: forall (f :: * -> *) (g :: * -> *) a. (:*:) f g a -> f a
fst1 (f a
l :*: g a
_) = f a
l
{-# INLINE fst1 #-}
snd1 :: (f :*: g) a -> g a
snd1 :: forall (f :: * -> *) (g :: * -> *) a. (:*:) f g a -> g a
snd1 (f a
_ :*: g a
r) = g a
r
{-# INLINE snd1 #-}