{-# OPTIONS_HADDOCK not-home #-}
-- | Definitions of concrete profunctors and profunctor classes.
module Data.Profunctor.Indexed
  (
    -- * Profunctor classes
    Profunctor(..)
  , lcoerce
  , rcoerce
  , Strong(..)
  , Costrong(..)
  , Choice(..)
  , Cochoice(..)
  , Visiting(..)
  , Mapping(..)
  , Traversing(..)

    -- * Concrete profunctors
  , Star(..)
  , reStar

  , Forget(..)
  , reForget

  , ForgetM(..)

  , FunArrow(..)
  , reFunArrow

  , IxStar(..)

  , IxForget(..)

  , IxForgetM(..)

  , IxFunArrow(..)

  , StarA(..)
  , runStarA

  , IxStarA(..)
  , runIxStarA

  , Exchange(..)
  , Store(..)
  , Market(..)
  , AffineMarket(..)
  , Tagged(..)
  , Context(..)

   -- * Utilities
  , (#.)
  , (.#)
  ) where

import Data.Coerce (Coercible, coerce)
import Data.Functor.Const
import Data.Functor.Identity

----------------------------------------
-- Concrete profunctors

-- | Needed for traversals.
newtype Star f i a b = Star { forall (f :: * -> *) i a b. Star f i a b -> a -> f b
runStar :: a -> f b }

-- | Needed for getters and folds.
newtype Forget r i a b = Forget { forall r i a b. Forget r i a b -> a -> r
runForget :: a -> r }

-- | Needed for affine folds.
newtype ForgetM r i a b = ForgetM { forall r i a b. ForgetM r i a b -> a -> Maybe r
runForgetM :: a -> Maybe r }

-- | Needed for setters.
newtype FunArrow i a b = FunArrow { forall i a b. FunArrow i a b -> a -> b
runFunArrow :: a -> b }

-- | Needed for indexed traversals.
newtype IxStar f i a b = IxStar { forall (f :: * -> *) i a b. IxStar f i a b -> i -> a -> f b
runIxStar :: i -> a -> f b }

-- | Needed for indexed folds.
newtype IxForget r i a b = IxForget { forall r i a b. IxForget r i a b -> i -> a -> r
runIxForget :: i -> a -> r }

-- | Needed for indexed affine folds.
newtype IxForgetM r i a b = IxForgetM { forall r i a b. IxForgetM r i a b -> i -> a -> Maybe r
runIxForgetM :: i -> a -> Maybe r }

-- | Needed for indexed setters.
newtype IxFunArrow i a b = IxFunArrow { forall i a b. IxFunArrow i a b -> i -> a -> b
runIxFunArrow :: i -> a -> b }

----------------------------------------
-- Utils

-- | Needed for conversion of affine traversal back to its VL representation.
data StarA f i a b = StarA (forall r. r -> f r) (a -> f b)

-- | Unwrap 'StarA'.
runStarA :: StarA f i a b -> a -> f b
runStarA :: forall (f :: * -> *) i a b. StarA f i a b -> a -> f b
runStarA (StarA forall r. r -> f r
_ a -> f b
k) = a -> f b
k

-- | Needed for conversion of indexed affine traversal back to its VL
-- representation.
data IxStarA f i a b = IxStarA (forall r. r -> f r) (i -> a -> f b)

-- | Unwrap 'StarA'.
runIxStarA :: IxStarA f i a b -> i -> a -> f b
runIxStarA :: forall (f :: * -> *) i a b. IxStarA f i a b -> i -> a -> f b
runIxStarA (IxStarA forall r. r -> f r
_ i -> a -> f b
k) = i -> a -> f b
k

----------------------------------------

-- | Repack 'Star' to change its index type.
reStar :: Star f i a b -> Star f j a b
reStar :: forall (f :: * -> *) i a b j. Star f i a b -> Star f j a b
reStar (Star a -> f b
k) = forall (f :: * -> *) i a b. (a -> f b) -> Star f i a b
Star a -> f b
k

-- | Repack 'Forget' to change its index type.
reForget :: Forget r i a b -> Forget r j a b
reForget :: forall r i a b j. Forget r i a b -> Forget r j a b
reForget (Forget a -> r
k) = forall r i a b. (a -> r) -> Forget r i a b
Forget a -> r
k

-- | Repack 'FunArrow' to change its index type.
reFunArrow :: FunArrow i a b -> FunArrow j a b
reFunArrow :: forall i a b j. FunArrow i a b -> FunArrow j a b
reFunArrow (FunArrow a -> b
k) = forall i a b. (a -> b) -> FunArrow i a b
FunArrow a -> b
k

----------------------------------------
-- Classes and instances

class Profunctor p where
  dimap :: (a -> b) -> (c -> d) -> p i b c -> p i a d
  lmap  :: (a -> b)             -> p i b c -> p i a c
  rmap  ::             (c -> d) -> p i b c -> p i b d

  lcoerce' :: Coercible a b => p i a c -> p i b c
  default lcoerce'
    :: Coercible (p i a c) (p i b c)
    => p i a c
    -> p i b c
  lcoerce' = coerce :: forall a b. Coercible a b => a -> b
coerce

  rcoerce' :: Coercible a b => p i c a -> p i c b
  default rcoerce'
    :: Coercible (p i c a) (p i c b)
    => p i c a
    -> p i c b
  rcoerce' = coerce :: forall a b. Coercible a b => a -> b
coerce

  conjoined__
    :: (p i a b -> p i s t)
    -> (p i a b -> p j s t)
    -> (p i a b -> p j s t)
  default conjoined__
    :: Coercible (p i s t) (p j s t)
    => (p i a b -> p i s t)
    -> (p i a b -> p j s t)
    -> (p i a b -> p j s t)
  conjoined__ p i a b -> p i s t
f p i a b -> p j s t
_ = coerce :: forall a b. Coercible a b => a -> b
coerce forall b c a. (b -> c) -> (a -> b) -> a -> c
. p i a b -> p i s t
f

  ixcontramap :: (j -> i) -> p i a b -> p j a b
  default ixcontramap
    :: Coercible (p i a b) (p j a b)
    => (j -> i)
    -> p i a b
    -> p j a b
  ixcontramap j -> i
_ = coerce :: forall a b. Coercible a b => a -> b
coerce

-- | 'rcoerce'' with type arguments rearranged for TypeApplications.
rcoerce :: (Coercible a b, Profunctor p) => p i c a -> p i c b
rcoerce :: forall a b (p :: * -> * -> * -> *) i c.
(Coercible a b, Profunctor p) =>
p i c a -> p i c b
rcoerce = forall (p :: * -> * -> * -> *) a b i c.
(Profunctor p, Coercible a b) =>
p i c a -> p i c b
rcoerce'

-- | 'lcoerce'' with type arguments rearranged for TypeApplications.
lcoerce :: (Coercible a b, Profunctor p) => p i a c -> p i b c
lcoerce :: forall a b (p :: * -> * -> * -> *) i c.
(Coercible a b, Profunctor p) =>
p i a c -> p i b c
lcoerce = forall (p :: * -> * -> * -> *) a b i c.
(Profunctor p, Coercible a b) =>
p i a c -> p i b c
lcoerce'

instance Functor f => Profunctor (StarA f) where
  dimap :: forall a b c d i.
(a -> b) -> (c -> d) -> StarA f i b c -> StarA f i a d
dimap a -> b
f c -> d
g (StarA forall r. r -> f r
point b -> f c
k) = forall (f :: * -> *) i a b.
(forall r. r -> f r) -> (a -> f b) -> StarA f i a b
StarA forall r. r -> f r
point (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> f c
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  lmap :: forall a b i c. (a -> b) -> StarA f i b c -> StarA f i a c
lmap  a -> b
f   (StarA forall r. r -> f r
point b -> f c
k) = forall (f :: * -> *) i a b.
(forall r. r -> f r) -> (a -> f b) -> StarA f i a b
StarA forall r. r -> f r
point (b -> f c
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  rmap :: forall c d i b. (c -> d) -> StarA f i b c -> StarA f i b d
rmap    c -> d
g (StarA forall r. r -> f r
point b -> f c
k) = forall (f :: * -> *) i a b.
(forall r. r -> f r) -> (a -> f b) -> StarA f i a b
StarA forall r. r -> f r
point (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> f c
k)

  rcoerce' :: forall a b i c. Coercible a b => StarA f i c a -> StarA f i c b
rcoerce' = forall (p :: * -> * -> * -> *) c d i b.
Profunctor p =>
(c -> d) -> p i b c -> p i b d
rmap coerce :: forall a b. Coercible a b => a -> b
coerce

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

  rcoerce' :: forall a b i c. Coercible a b => Star f i c a -> Star f i c b
rcoerce' = forall (p :: * -> * -> * -> *) c d i b.
Profunctor p =>
(c -> d) -> p i b c -> p i b d
rmap coerce :: forall a b. Coercible a b => a -> b
coerce

instance Profunctor (Forget r) where
  dimap :: forall a b c d i.
(a -> b) -> (c -> d) -> Forget r i b c -> Forget r i a d
dimap a -> b
f c -> d
_ (Forget b -> r
k) = forall r i a b. (a -> r) -> Forget r i a b
Forget (b -> r
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  lmap :: forall a b i c. (a -> b) -> Forget r i b c -> Forget r i a c
lmap  a -> b
f   (Forget b -> r
k) = forall r i a b. (a -> r) -> Forget r i a b
Forget (b -> r
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  rmap :: forall c d i b. (c -> d) -> Forget r i b c -> Forget r i b d
rmap   c -> d
_g (Forget b -> r
k) = forall r i a b. (a -> r) -> Forget r i a b
Forget b -> r
k

instance Profunctor (ForgetM r) where
  dimap :: forall a b c d i.
(a -> b) -> (c -> d) -> ForgetM r i b c -> ForgetM r i a d
dimap a -> b
f c -> d
_ (ForgetM b -> Maybe r
k) = forall r i a b. (a -> Maybe r) -> ForgetM r i a b
ForgetM (b -> Maybe r
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  lmap :: forall a b i c. (a -> b) -> ForgetM r i b c -> ForgetM r i a c
lmap  a -> b
f   (ForgetM b -> Maybe r
k) = forall r i a b. (a -> Maybe r) -> ForgetM r i a b
ForgetM (b -> Maybe r
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  rmap :: forall c d i b. (c -> d) -> ForgetM r i b c -> ForgetM r i b d
rmap   c -> d
_g (ForgetM b -> Maybe r
k) = forall r i a b. (a -> Maybe r) -> ForgetM r i a b
ForgetM b -> Maybe r
k

instance Profunctor FunArrow where
  dimap :: forall a b c d i.
(a -> b) -> (c -> d) -> FunArrow i b c -> FunArrow i a d
dimap a -> b
f c -> d
g (FunArrow b -> c
k) = forall i a b. (a -> b) -> FunArrow i a b
FunArrow (c -> d
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> c
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  lmap :: forall a b i c. (a -> b) -> FunArrow i b c -> FunArrow i a c
lmap  a -> b
f   (FunArrow b -> c
k) = forall i a b. (a -> b) -> FunArrow i a b
FunArrow (b -> c
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  rmap :: forall c d i b. (c -> d) -> FunArrow i b c -> FunArrow i b d
rmap    c -> d
g (FunArrow b -> c
k) = forall i a b. (a -> b) -> FunArrow i a b
FunArrow (c -> d
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> c
k)

instance Functor f => Profunctor (IxStarA f) where
  dimap :: forall a b c d i.
(a -> b) -> (c -> d) -> IxStarA f i b c -> IxStarA f i a d
dimap a -> b
f c -> d
g (IxStarA forall r. r -> f r
point i -> b -> f c
k) = forall (f :: * -> *) i a b.
(forall r. r -> f r) -> (i -> a -> f b) -> IxStarA f i a b
IxStarA forall r. r -> f r
point (\i
i -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> b -> f c
k i
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  lmap :: forall a b i c. (a -> b) -> IxStarA f i b c -> IxStarA f i a c
lmap  a -> b
f   (IxStarA forall r. r -> f r
point i -> b -> f c
k) = forall (f :: * -> *) i a b.
(forall r. r -> f r) -> (i -> a -> f b) -> IxStarA f i a b
IxStarA forall r. r -> f r
point (\i
i -> i -> b -> f c
k i
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  rmap :: forall c d i b. (c -> d) -> IxStarA f i b c -> IxStarA f i b d
rmap    c -> d
g (IxStarA forall r. r -> f r
point i -> b -> f c
k) = forall (f :: * -> *) i a b.
(forall r. r -> f r) -> (i -> a -> f b) -> IxStarA f i a b
IxStarA forall r. r -> f r
point (\i
i -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> b -> f c
k i
i)

  rcoerce' :: forall a b i c. Coercible a b => IxStarA f i c a -> IxStarA f i c b
rcoerce' = forall (p :: * -> * -> * -> *) c d i b.
Profunctor p =>
(c -> d) -> p i b c -> p i b d
rmap coerce :: forall a b. Coercible a b => a -> b
coerce

  conjoined__ :: forall i a b s t j.
(IxStarA f i a b -> IxStarA f i s t)
-> (IxStarA f i a b -> IxStarA f j s t)
-> IxStarA f i a b
-> IxStarA f j s t
conjoined__ IxStarA f i a b -> IxStarA f i s t
_ IxStarA f i a b -> IxStarA f j s t
f = IxStarA f i a b -> IxStarA f j s t
f
  ixcontramap :: forall j i a b. (j -> i) -> IxStarA f i a b -> IxStarA f j a b
ixcontramap j -> i
ij (IxStarA forall r. r -> f r
point i -> a -> f b
k) = forall (f :: * -> *) i a b.
(forall r. r -> f r) -> (i -> a -> f b) -> IxStarA f i a b
IxStarA forall r. r -> f r
point forall a b. (a -> b) -> a -> b
$ \j
i -> i -> a -> f b
k (j -> i
ij j
i)

instance Functor f => Profunctor (IxStar f) where
  dimap :: forall a b c d i.
(a -> b) -> (c -> d) -> IxStar f i b c -> IxStar f i a d
dimap a -> b
f c -> d
g (IxStar i -> b -> f c
k) = forall (f :: * -> *) i a b. (i -> a -> f b) -> IxStar f i a b
IxStar (\i
i -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> b -> f c
k i
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  lmap :: forall a b i c. (a -> b) -> IxStar f i b c -> IxStar f i a c
lmap  a -> b
f   (IxStar i -> b -> f c
k) = forall (f :: * -> *) i a b. (i -> a -> f b) -> IxStar f i a b
IxStar (\i
i -> i -> b -> f c
k i
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  rmap :: forall c d i b. (c -> d) -> IxStar f i b c -> IxStar f i b d
rmap    c -> d
g (IxStar i -> b -> f c
k) = forall (f :: * -> *) i a b. (i -> a -> f b) -> IxStar f i a b
IxStar (\i
i -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> b -> f c
k i
i)

  rcoerce' :: forall a b i c. Coercible a b => IxStar f i c a -> IxStar f i c b
rcoerce' = forall (p :: * -> * -> * -> *) c d i b.
Profunctor p =>
(c -> d) -> p i b c -> p i b d
rmap coerce :: forall a b. Coercible a b => a -> b
coerce

  conjoined__ :: forall i a b s t j.
(IxStar f i a b -> IxStar f i s t)
-> (IxStar f i a b -> IxStar f j s t)
-> IxStar f i a b
-> IxStar f j s t
conjoined__ IxStar f i a b -> IxStar f i s t
_ IxStar f i a b -> IxStar f j s t
f = IxStar f i a b -> IxStar f j s t
f
  ixcontramap :: forall j i a b. (j -> i) -> IxStar f i a b -> IxStar f j a b
ixcontramap j -> i
ij (IxStar i -> a -> f b
k) = forall (f :: * -> *) i a b. (i -> a -> f b) -> IxStar f i a b
IxStar forall a b. (a -> b) -> a -> b
$ \j
i -> i -> a -> f b
k (j -> i
ij j
i)

instance Profunctor (IxForget r) where
  dimap :: forall a b c d i.
(a -> b) -> (c -> d) -> IxForget r i b c -> IxForget r i a d
dimap a -> b
f c -> d
_ (IxForget i -> b -> r
k) = forall r i a b. (i -> a -> r) -> IxForget r i a b
IxForget (\i
i -> i -> b -> r
k i
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  lmap :: forall a b i c. (a -> b) -> IxForget r i b c -> IxForget r i a c
lmap  a -> b
f   (IxForget i -> b -> r
k) = forall r i a b. (i -> a -> r) -> IxForget r i a b
IxForget (\i
i -> i -> b -> r
k i
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  rmap :: forall c d i b. (c -> d) -> IxForget r i b c -> IxForget r i b d
rmap   c -> d
_g (IxForget i -> b -> r
k) = forall r i a b. (i -> a -> r) -> IxForget r i a b
IxForget i -> b -> r
k

  conjoined__ :: forall i a b s t j.
(IxForget r i a b -> IxForget r i s t)
-> (IxForget r i a b -> IxForget r j s t)
-> IxForget r i a b
-> IxForget r j s t
conjoined__ IxForget r i a b -> IxForget r i s t
_ IxForget r i a b -> IxForget r j s t
f = IxForget r i a b -> IxForget r j s t
f
  ixcontramap :: forall j i a b. (j -> i) -> IxForget r i a b -> IxForget r j a b
ixcontramap j -> i
ij (IxForget i -> a -> r
k) = forall r i a b. (i -> a -> r) -> IxForget r i a b
IxForget forall a b. (a -> b) -> a -> b
$ \j
i -> i -> a -> r
k (j -> i
ij j
i)

instance Profunctor (IxForgetM r) where
  dimap :: forall a b c d i.
(a -> b) -> (c -> d) -> IxForgetM r i b c -> IxForgetM r i a d
dimap a -> b
f c -> d
_ (IxForgetM i -> b -> Maybe r
k) = forall r i a b. (i -> a -> Maybe r) -> IxForgetM r i a b
IxForgetM (\i
i -> i -> b -> Maybe r
k i
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  lmap :: forall a b i c. (a -> b) -> IxForgetM r i b c -> IxForgetM r i a c
lmap  a -> b
f   (IxForgetM i -> b -> Maybe r
k) = forall r i a b. (i -> a -> Maybe r) -> IxForgetM r i a b
IxForgetM (\i
i -> i -> b -> Maybe r
k i
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  rmap :: forall c d i b. (c -> d) -> IxForgetM r i b c -> IxForgetM r i b d
rmap   c -> d
_g (IxForgetM i -> b -> Maybe r
k) = forall r i a b. (i -> a -> Maybe r) -> IxForgetM r i a b
IxForgetM i -> b -> Maybe r
k

  conjoined__ :: forall i a b s t j.
(IxForgetM r i a b -> IxForgetM r i s t)
-> (IxForgetM r i a b -> IxForgetM r j s t)
-> IxForgetM r i a b
-> IxForgetM r j s t
conjoined__ IxForgetM r i a b -> IxForgetM r i s t
_ IxForgetM r i a b -> IxForgetM r j s t
f = IxForgetM r i a b -> IxForgetM r j s t
f
  ixcontramap :: forall j i a b. (j -> i) -> IxForgetM r i a b -> IxForgetM r j a b
ixcontramap j -> i
ij (IxForgetM i -> a -> Maybe r
k) = forall r i a b. (i -> a -> Maybe r) -> IxForgetM r i a b
IxForgetM forall a b. (a -> b) -> a -> b
$ \j
i -> i -> a -> Maybe r
k (j -> i
ij j
i)

instance Profunctor IxFunArrow where
  dimap :: forall a b c d i.
(a -> b) -> (c -> d) -> IxFunArrow i b c -> IxFunArrow i a d
dimap a -> b
f c -> d
g (IxFunArrow i -> b -> c
k) = forall i a b. (i -> a -> b) -> IxFunArrow i a b
IxFunArrow (\i
i -> c -> d
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> b -> c
k i
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  lmap :: forall a b i c. (a -> b) -> IxFunArrow i b c -> IxFunArrow i a c
lmap  a -> b
f   (IxFunArrow i -> b -> c
k) = forall i a b. (i -> a -> b) -> IxFunArrow i a b
IxFunArrow (\i
i -> i -> b -> c
k i
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  rmap :: forall c d i b. (c -> d) -> IxFunArrow i b c -> IxFunArrow i b d
rmap    c -> d
g (IxFunArrow i -> b -> c
k) = forall i a b. (i -> a -> b) -> IxFunArrow i a b
IxFunArrow (\i
i -> c -> d
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> b -> c
k i
i)

  conjoined__ :: forall i a b s t j.
(IxFunArrow i a b -> IxFunArrow i s t)
-> (IxFunArrow i a b -> IxFunArrow j s t)
-> IxFunArrow i a b
-> IxFunArrow j s t
conjoined__ IxFunArrow i a b -> IxFunArrow i s t
_ IxFunArrow i a b -> IxFunArrow j s t
f = IxFunArrow i a b -> IxFunArrow j s t
f
  ixcontramap :: forall j i a b. (j -> i) -> IxFunArrow i a b -> IxFunArrow j a b
ixcontramap j -> i
ij (IxFunArrow i -> a -> b
k) = forall i a b. (i -> a -> b) -> IxFunArrow i a b
IxFunArrow forall a b. (a -> b) -> a -> b
$ \j
i -> i -> a -> b
k (j -> i
ij j
i)

----------------------------------------

class Profunctor p => Strong p where
  first'  :: p i a b -> p i (a, c) (b, c)
  second' :: p i a b -> p i (c, a) (c, b)

  -- There are a few places where default implementation is good enough.
  linear
    :: (forall f. Functor f => (a -> f b) -> s -> f t)
    -> p i a b
    -> p i s t
  linear forall (f :: * -> *). Functor f => (a -> f b) -> s -> f t
f = forall (p :: * -> * -> * -> *) a b c d i.
Profunctor p =>
(a -> b) -> (c -> d) -> p i b c -> p i a d
dimap
    ((\(Context b -> t
bt a
a) -> (a
a, b -> t
bt)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *). Functor f => (a -> f b) -> s -> f t
f (forall a b t. (b -> t) -> a -> Context a b t
Context forall a. a -> a
id))
    (\(b
b, b -> t
bt) -> b -> t
bt b
b)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> * -> *) i a b c.
Strong p =>
p i a b -> p i (a, c) (b, c)
first'

  -- There are a few places where default implementation is good enough.
  ilinear
    :: (forall f. Functor f => (i -> a -> f b) -> s -> f t)
    -> p       j  a b
    -> p (i -> j) s t
  default ilinear
    :: Coercible (p j s t) (p (i -> j) s t)
    => (forall f. Functor f => (i -> a -> f b) -> s -> f t)
    -> p       j  a b
    -> p (i -> j) s t
  ilinear forall (f :: * -> *). Functor f => (i -> a -> f b) -> s -> f t
f = coerce :: forall a b. Coercible a b => a -> b
coerce forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> * -> *) a b s t i.
Strong p =>
(forall (f :: * -> *). Functor f => (a -> f b) -> s -> f t)
-> p i a b -> p i s t
linear (\a -> f b
afb -> forall (f :: * -> *). Functor f => (i -> a -> f b) -> s -> f t
f forall a b. (a -> b) -> a -> b
$ \i
_ -> a -> f b
afb)

instance Functor f => Strong (StarA f) where
  first' :: forall i a b c. StarA f i a b -> StarA f i (a, c) (b, c)
first'  (StarA forall r. r -> f r
point a -> f b
k) = forall (f :: * -> *) i a b.
(forall r. r -> f r) -> (a -> f b) -> StarA f i a b
StarA forall r. r -> f r
point forall a b. (a -> b) -> a -> b
$ \ ~(a
a, c
c) -> (\b
b' -> (b
b', c
c)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
k a
a
  second' :: forall i a b c. StarA f i a b -> StarA f i (c, a) (c, b)
second' (StarA forall r. r -> f r
point a -> f b
k) = forall (f :: * -> *) i a b.
(forall r. r -> f r) -> (a -> f b) -> StarA f i a b
StarA forall r. r -> f r
point forall a b. (a -> b) -> a -> b
$ \ ~(c
c, a
a) -> (,) c
c forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
k a
a

  linear :: forall a b s t i.
(forall (f :: * -> *). Functor f => (a -> f b) -> s -> f t)
-> StarA f i a b -> StarA f i s t
linear forall (f :: * -> *). Functor f => (a -> f b) -> s -> f t
f (StarA forall r. r -> f r
point a -> f b
k) = forall (f :: * -> *) i a b.
(forall r. r -> f r) -> (a -> f b) -> StarA f i a b
StarA forall r. r -> f r
point (forall (f :: * -> *). Functor f => (a -> f b) -> s -> f t
f a -> f b
k)

instance Functor f => Strong (Star f) where
  first' :: forall i a b c. Star f i a b -> Star f i (a, c) (b, c)
first'  (Star a -> f b
k) = forall (f :: * -> *) i a b. (a -> f b) -> Star f i a b
Star forall a b. (a -> b) -> a -> b
$ \ ~(a
a, c
c) -> (\b
b' -> (b
b', c
c)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
k a
a
  second' :: forall i a b c. Star f i a b -> Star f i (c, a) (c, b)
second' (Star a -> f b
k) = forall (f :: * -> *) i a b. (a -> f b) -> Star f i a b
Star forall a b. (a -> b) -> a -> b
$ \ ~(c
c, a
a) -> (,) c
c forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
k a
a

  linear :: forall a b s t i.
(forall (f :: * -> *). Functor f => (a -> f b) -> s -> f t)
-> Star f i a b -> Star f i s t
linear forall (f :: * -> *). Functor f => (a -> f b) -> s -> f t
f (Star a -> f b
k) = forall (f :: * -> *) i a b. (a -> f b) -> Star f i a b
Star (forall (f :: * -> *). Functor f => (a -> f b) -> s -> f t
f a -> f b
k)

instance Strong (Forget r) where
  first' :: forall i a b c. Forget r i a b -> Forget r i (a, c) (b, c)
first'  (Forget a -> r
k) = forall r i a b. (a -> r) -> Forget r i a b
Forget (a -> r
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
  second' :: forall i a b c. Forget r i a b -> Forget r i (c, a) (c, b)
second' (Forget a -> r
k) = forall r i a b. (a -> r) -> Forget r i a b
Forget (a -> r
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)

  linear :: forall a b s t i.
(forall (f :: * -> *). Functor f => (a -> f b) -> s -> f t)
-> Forget r i a b -> Forget r i s t
linear forall (f :: * -> *). Functor f => (a -> f b) -> s -> f t
f (Forget a -> r
k) = forall r i a b. (a -> r) -> Forget r i a b
Forget (forall {k} a (b :: k). Const a b -> a
getConst forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall (f :: * -> *). Functor f => (a -> f b) -> s -> f t
f (forall {k} a (b :: k). a -> Const a b
Const forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. a -> r
k))

instance Strong (ForgetM r) where
  first' :: forall i a b c. ForgetM r i a b -> ForgetM r i (a, c) (b, c)
first'  (ForgetM a -> Maybe r
k) = forall r i a b. (a -> Maybe r) -> ForgetM r i a b
ForgetM (a -> Maybe r
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
  second' :: forall i a b c. ForgetM r i a b -> ForgetM r i (c, a) (c, b)
second' (ForgetM a -> Maybe r
k) = forall r i a b. (a -> Maybe r) -> ForgetM r i a b
ForgetM (a -> Maybe r
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)

  linear :: forall a b s t i.
(forall (f :: * -> *). Functor f => (a -> f b) -> s -> f t)
-> ForgetM r i a b -> ForgetM r i s t
linear forall (f :: * -> *). Functor f => (a -> f b) -> s -> f t
f (ForgetM a -> Maybe r
k) = forall r i a b. (a -> Maybe r) -> ForgetM r i a b
ForgetM (forall {k} a (b :: k). Const a b -> a
getConst forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall (f :: * -> *). Functor f => (a -> f b) -> s -> f t
f (forall {k} a (b :: k). a -> Const a b
Const forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. a -> Maybe r
k))

instance Strong FunArrow where
  first' :: forall i a b c. FunArrow i a b -> FunArrow i (a, c) (b, c)
first'  (FunArrow a -> b
k) = forall i a b. (a -> b) -> FunArrow i a b
FunArrow forall a b. (a -> b) -> a -> b
$ \ ~(a
a, c
c) -> (a -> b
k a
a, c
c)
  second' :: forall i a b c. FunArrow i a b -> FunArrow i (c, a) (c, b)
second' (FunArrow a -> b
k) = forall i a b. (a -> b) -> FunArrow i a b
FunArrow forall a b. (a -> b) -> a -> b
$ \ ~(c
c, a
a) -> (c
c, a -> b
k a
a)

  linear :: forall a b s t i.
(forall (f :: * -> *). Functor f => (a -> f b) -> s -> f t)
-> FunArrow i a b -> FunArrow i s t
linear forall (f :: * -> *). Functor f => (a -> f b) -> s -> f t
f (FunArrow a -> b
k) = forall i a b. (a -> b) -> FunArrow i a b
FunArrow forall a b. (a -> b) -> a -> b
$ forall a. Identity a -> a
runIdentity forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall (f :: * -> *). Functor f => (a -> f b) -> s -> f t
f (forall a. a -> Identity a
Identity forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. a -> b
k)

instance Functor f => Strong (IxStarA f) where
  first' :: forall i a b c. IxStarA f i a b -> IxStarA f i (a, c) (b, c)
first'  (IxStarA forall r. r -> f r
point i -> a -> f b
k) = forall (f :: * -> *) i a b.
(forall r. r -> f r) -> (i -> a -> f b) -> IxStarA f i a b
IxStarA forall r. r -> f r
point forall a b. (a -> b) -> a -> b
$ \i
i ~(a
a, c
c) -> (\b
b' -> (b
b', c
c)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> i -> a -> f b
k i
i a
a
  second' :: forall i a b c. IxStarA f i a b -> IxStarA f i (c, a) (c, b)
second' (IxStarA forall r. r -> f r
point i -> a -> f b
k) = forall (f :: * -> *) i a b.
(forall r. r -> f r) -> (i -> a -> f b) -> IxStarA f i a b
IxStarA forall r. r -> f r
point forall a b. (a -> b) -> a -> b
$ \i
i ~(c
c, a
a) -> (,) c
c forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> i -> a -> f b
k i
i a
a

  linear :: forall a b s t i.
(forall (f :: * -> *). Functor f => (a -> f b) -> s -> f t)
-> IxStarA f i a b -> IxStarA f i s t
linear forall (f :: * -> *). Functor f => (a -> f b) -> s -> f t
f (IxStarA forall r. r -> f r
point i -> a -> f b
k) = forall (f :: * -> *) i a b.
(forall r. r -> f r) -> (i -> a -> f b) -> IxStarA f i a b
IxStarA forall r. r -> f r
point forall a b. (a -> b) -> a -> b
$ \i
i -> forall (f :: * -> *). Functor f => (a -> f b) -> s -> f t
f (i -> a -> f b
k i
i)
  ilinear :: forall i a b s t j.
(forall (f :: * -> *). Functor f => (i -> a -> f b) -> s -> f t)
-> IxStarA f j a b -> IxStarA f (i -> j) s t
ilinear forall (f :: * -> *). Functor f => (i -> a -> f b) -> s -> f t
f (IxStarA forall r. r -> f r
point j -> a -> f b
k) = forall (f :: * -> *) i a b.
(forall r. r -> f r) -> (i -> a -> f b) -> IxStarA f i a b
IxStarA forall r. r -> f r
point forall a b. (a -> b) -> a -> b
$ \i -> j
ij -> forall (f :: * -> *). Functor f => (i -> a -> f b) -> s -> f t
f forall a b. (a -> b) -> a -> b
$ \i
i -> j -> a -> f b
k (i -> j
ij i
i)

instance Functor f => Strong (IxStar f) where
  first' :: forall i a b c. IxStar f i a b -> IxStar f i (a, c) (b, c)
first'  (IxStar i -> a -> f b
k) = forall (f :: * -> *) i a b. (i -> a -> f b) -> IxStar f i a b
IxStar forall a b. (a -> b) -> a -> b
$ \i
i ~(a
a, c
c) -> (\b
b' -> (b
b', c
c)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> i -> a -> f b
k i
i a
a
  second' :: forall i a b c. IxStar f i a b -> IxStar f i (c, a) (c, b)
second' (IxStar i -> a -> f b
k) = forall (f :: * -> *) i a b. (i -> a -> f b) -> IxStar f i a b
IxStar forall a b. (a -> b) -> a -> b
$ \i
i ~(c
c, a
a) -> (,) c
c forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> i -> a -> f b
k i
i a
a

  linear :: forall a b s t i.
(forall (f :: * -> *). Functor f => (a -> f b) -> s -> f t)
-> IxStar f i a b -> IxStar f i s t
linear forall (f :: * -> *). Functor f => (a -> f b) -> s -> f t
f (IxStar i -> a -> f b
k) = forall (f :: * -> *) i a b. (i -> a -> f b) -> IxStar f i a b
IxStar forall a b. (a -> b) -> a -> b
$ \i
i -> forall (f :: * -> *). Functor f => (a -> f b) -> s -> f t
f (i -> a -> f b
k i
i)
  ilinear :: forall i a b s t j.
(forall (f :: * -> *). Functor f => (i -> a -> f b) -> s -> f t)
-> IxStar f j a b -> IxStar f (i -> j) s t
ilinear forall (f :: * -> *). Functor f => (i -> a -> f b) -> s -> f t
f (IxStar j -> a -> f b
k) = forall (f :: * -> *) i a b. (i -> a -> f b) -> IxStar f i a b
IxStar forall a b. (a -> b) -> a -> b
$ \i -> j
ij -> forall (f :: * -> *). Functor f => (i -> a -> f b) -> s -> f t
f forall a b. (a -> b) -> a -> b
$ \i
i -> j -> a -> f b
k (i -> j
ij i
i)

instance Strong (IxForget r) where
  first' :: forall i a b c. IxForget r i a b -> IxForget r i (a, c) (b, c)
first'  (IxForget i -> a -> r
k) = forall r i a b. (i -> a -> r) -> IxForget r i a b
IxForget forall a b. (a -> b) -> a -> b
$ \i
i -> i -> a -> r
k i
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst
  second' :: forall i a b c. IxForget r i a b -> IxForget r i (c, a) (c, b)
second' (IxForget i -> a -> r
k) = forall r i a b. (i -> a -> r) -> IxForget r i a b
IxForget forall a b. (a -> b) -> a -> b
$ \i
i -> i -> a -> r
k i
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd

  linear :: forall a b s t i.
(forall (f :: * -> *). Functor f => (a -> f b) -> s -> f t)
-> IxForget r i a b -> IxForget r i s t
linear forall (f :: * -> *). Functor f => (a -> f b) -> s -> f t
f (IxForget i -> a -> r
k) = forall r i a b. (i -> a -> r) -> IxForget r i a b
IxForget forall a b. (a -> b) -> a -> b
$ \i
i -> forall {k} a (b :: k). Const a b -> a
getConst forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall (f :: * -> *). Functor f => (a -> f b) -> s -> f t
f (forall {k} a (b :: k). a -> Const a b
Const forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. i -> a -> r
k i
i)
  ilinear :: forall i a b s t j.
(forall (f :: * -> *). Functor f => (i -> a -> f b) -> s -> f t)
-> IxForget r j a b -> IxForget r (i -> j) s t
ilinear forall (f :: * -> *). Functor f => (i -> a -> f b) -> s -> f t
f (IxForget j -> a -> r
k) = forall r i a b. (i -> a -> r) -> IxForget r i a b
IxForget forall a b. (a -> b) -> a -> b
$ \i -> j
ij -> forall {k} a (b :: k). Const a b -> a
getConst forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall (f :: * -> *). Functor f => (i -> a -> f b) -> s -> f t
f (\i
i -> forall {k} a (b :: k). a -> Const a b
Const forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. j -> a -> r
k (i -> j
ij i
i))

instance Strong (IxForgetM r) where
  first' :: forall i a b c. IxForgetM r i a b -> IxForgetM r i (a, c) (b, c)
first'  (IxForgetM i -> a -> Maybe r
k) = forall r i a b. (i -> a -> Maybe r) -> IxForgetM r i a b
IxForgetM forall a b. (a -> b) -> a -> b
$ \i
i -> i -> a -> Maybe r
k i
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst
  second' :: forall i a b c. IxForgetM r i a b -> IxForgetM r i (c, a) (c, b)
second' (IxForgetM i -> a -> Maybe r
k) = forall r i a b. (i -> a -> Maybe r) -> IxForgetM r i a b
IxForgetM forall a b. (a -> b) -> a -> b
$ \i
i -> i -> a -> Maybe r
k i
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd

  linear :: forall a b s t i.
(forall (f :: * -> *). Functor f => (a -> f b) -> s -> f t)
-> IxForgetM r i a b -> IxForgetM r i s t
linear forall (f :: * -> *). Functor f => (a -> f b) -> s -> f t
f (IxForgetM i -> a -> Maybe r
k) = forall r i a b. (i -> a -> Maybe r) -> IxForgetM r i a b
IxForgetM forall a b. (a -> b) -> a -> b
$ \i
i -> forall {k} a (b :: k). Const a b -> a
getConst forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall (f :: * -> *). Functor f => (a -> f b) -> s -> f t
f (forall {k} a (b :: k). a -> Const a b
Const forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. i -> a -> Maybe r
k i
i)
  ilinear :: forall i a b s t j.
(forall (f :: * -> *). Functor f => (i -> a -> f b) -> s -> f t)
-> IxForgetM r j a b -> IxForgetM r (i -> j) s t
ilinear forall (f :: * -> *). Functor f => (i -> a -> f b) -> s -> f t
f (IxForgetM j -> a -> Maybe r
k) = forall r i a b. (i -> a -> Maybe r) -> IxForgetM r i a b
IxForgetM forall a b. (a -> b) -> a -> b
$ \i -> j
ij -> forall {k} a (b :: k). Const a b -> a
getConst forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall (f :: * -> *). Functor f => (i -> a -> f b) -> s -> f t
f (\i
i -> forall {k} a (b :: k). a -> Const a b
Const forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. j -> a -> Maybe r
k (i -> j
ij i
i))

instance Strong IxFunArrow where
  first' :: forall i a b c. IxFunArrow i a b -> IxFunArrow i (a, c) (b, c)
first'  (IxFunArrow i -> a -> b
k) = forall i a b. (i -> a -> b) -> IxFunArrow i a b
IxFunArrow forall a b. (a -> b) -> a -> b
$ \i
i ~(a
a, c
c) -> (i -> a -> b
k i
i a
a, c
c)
  second' :: forall i a b c. IxFunArrow i a b -> IxFunArrow i (c, a) (c, b)
second' (IxFunArrow i -> a -> b
k) = forall i a b. (i -> a -> b) -> IxFunArrow i a b
IxFunArrow forall a b. (a -> b) -> a -> b
$ \i
i ~(c
c, a
a) -> (c
c, i -> a -> b
k i
i a
a)

  linear :: forall a b s t i.
(forall (f :: * -> *). Functor f => (a -> f b) -> s -> f t)
-> IxFunArrow i a b -> IxFunArrow i s t
linear forall (f :: * -> *). Functor f => (a -> f b) -> s -> f t
f (IxFunArrow i -> a -> b
k) = forall i a b. (i -> a -> b) -> IxFunArrow i a b
IxFunArrow forall a b. (a -> b) -> a -> b
$ \i
i ->
    forall a. Identity a -> a
runIdentity forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall (f :: * -> *). Functor f => (a -> f b) -> s -> f t
f (forall a. a -> Identity a
Identity forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. i -> a -> b
k i
i)
  ilinear :: forall i a b s t j.
(forall (f :: * -> *). Functor f => (i -> a -> f b) -> s -> f t)
-> IxFunArrow j a b -> IxFunArrow (i -> j) s t
ilinear forall (f :: * -> *). Functor f => (i -> a -> f b) -> s -> f t
f (IxFunArrow j -> a -> b
k) = forall i a b. (i -> a -> b) -> IxFunArrow i a b
IxFunArrow forall a b. (a -> b) -> a -> b
$ \i -> j
ij ->
    forall a. Identity a -> a
runIdentity forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall (f :: * -> *). Functor f => (i -> a -> f b) -> s -> f t
f (\i
i -> forall a. a -> Identity a
Identity forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. j -> a -> b
k (i -> j
ij i
i))

----------------------------------------

class Profunctor p => Costrong p where
  unfirst  :: p i (a, d) (b, d) -> p i a b
  unsecond :: p i (d, a) (d, b) -> p i a b

----------------------------------------

class Profunctor p => Choice p where
  left'  :: p i a b -> p i (Either a c) (Either b c)
  right' :: p i a b -> p i (Either c a) (Either c b)

instance Functor f => Choice (StarA f) where
  left' :: forall i a b c.
StarA f i a b -> StarA f i (Either a c) (Either b c)
left'  (StarA forall r. r -> f r
point a -> f b
k) = forall (f :: * -> *) i a b.
(forall r. r -> f r) -> (a -> f b) -> StarA f i a b
StarA forall r. r -> f r
point forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f b
k) (forall r. r -> f r
point forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right)
  right' :: forall i a b c.
StarA f i a b -> StarA f i (Either c a) (Either c b)
right' (StarA forall r. r -> f r
point a -> f b
k) = forall (f :: * -> *) i a b.
(forall r. r -> f r) -> (a -> f b) -> StarA f i a b
StarA forall r. r -> f r
point forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall r. r -> f r
point forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f b
k)

instance Applicative f => Choice (Star f) where
  left' :: forall i a b c. Star f i a b -> Star f i (Either a c) (Either b c)
left'  (Star a -> f b
k) = forall (f :: * -> *) i a b. (a -> f b) -> Star f i a b
Star forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f b
k) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right)
  right' :: forall i a b c. Star f i a b -> Star f i (Either c a) (Either c b)
right' (Star a -> f b
k) = forall (f :: * -> *) i a b. (a -> f b) -> Star f i a b
Star forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f b
k)

instance Monoid r => Choice (Forget r) where
  left' :: forall i a b c.
Forget r i a b -> Forget r i (Either a c) (Either b c)
left'  (Forget a -> r
k) = forall r i a b. (a -> r) -> Forget r i a b
Forget forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> r
k (forall a b. a -> b -> a
const forall a. Monoid a => a
mempty)
  right' :: forall i a b c.
Forget r i a b -> Forget r i (Either c a) (Either c b)
right' (Forget a -> r
k) = forall r i a b. (a -> r) -> Forget r i a b
Forget forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Monoid a => a
mempty) a -> r
k

instance Choice (ForgetM r) where
  left' :: forall i a b c.
ForgetM r i a b -> ForgetM r i (Either a c) (Either b c)
left'  (ForgetM a -> Maybe r
k) = forall r i a b. (a -> Maybe r) -> ForgetM r i a b
ForgetM forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> Maybe r
k (forall a b. a -> b -> a
const forall a. Maybe a
Nothing)
  right' :: forall i a b c.
ForgetM r i a b -> ForgetM r i (Either c a) (Either c b)
right' (ForgetM a -> Maybe r
k) = forall r i a b. (a -> Maybe r) -> ForgetM r i a b
ForgetM forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) a -> Maybe r
k

instance Choice FunArrow where
  left' :: forall i a b c.
FunArrow i a b -> FunArrow i (Either a c) (Either b c)
left'  (FunArrow a -> b
k) = forall i a b. (a -> b) -> FunArrow i a b
FunArrow forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
k) forall a b. b -> Either a b
Right
  right' :: forall i a b c.
FunArrow i a b -> FunArrow i (Either c a) (Either c b)
right' (FunArrow a -> b
k) = forall i a b. (a -> b) -> FunArrow i a b
FunArrow forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a b. a -> Either a b
Left (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
k)

instance Functor f => Choice (IxStarA f) where
  left' :: forall i a b c.
IxStarA f i a b -> IxStarA f i (Either a c) (Either b c)
left'  (IxStarA forall r. r -> f r
point i -> a -> f b
k) =
    forall (f :: * -> *) i a b.
(forall r. r -> f r) -> (i -> a -> f b) -> IxStarA f i a b
IxStarA forall r. r -> f r
point forall a b. (a -> b) -> a -> b
$ \i
i -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> a -> f b
k i
i) (forall r. r -> f r
point forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right)
  right' :: forall i a b c.
IxStarA f i a b -> IxStarA f i (Either c a) (Either c b)
right' (IxStarA forall r. r -> f r
point i -> a -> f b
k) =
    forall (f :: * -> *) i a b.
(forall r. r -> f r) -> (i -> a -> f b) -> IxStarA f i a b
IxStarA forall r. r -> f r
point forall a b. (a -> b) -> a -> b
$ \i
i -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall r. r -> f r
point forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> a -> f b
k i
i)

instance Applicative f => Choice (IxStar f) where
  left' :: forall i a b c.
IxStar f i a b -> IxStar f i (Either a c) (Either b c)
left'  (IxStar i -> a -> f b
k) = forall (f :: * -> *) i a b. (i -> a -> f b) -> IxStar f i a b
IxStar forall a b. (a -> b) -> a -> b
$ \i
i -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> a -> f b
k i
i) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right)
  right' :: forall i a b c.
IxStar f i a b -> IxStar f i (Either c a) (Either c b)
right' (IxStar i -> a -> f b
k) = forall (f :: * -> *) i a b. (i -> a -> f b) -> IxStar f i a b
IxStar forall a b. (a -> b) -> a -> b
$ \i
i -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> a -> f b
k i
i)

instance Monoid r => Choice (IxForget r) where
  left' :: forall i a b c.
IxForget r i a b -> IxForget r i (Either a c) (Either b c)
left'  (IxForget i -> a -> r
k) = forall r i a b. (i -> a -> r) -> IxForget r i a b
IxForget forall a b. (a -> b) -> a -> b
$ \i
i -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (i -> a -> r
k i
i) (forall a b. a -> b -> a
const forall a. Monoid a => a
mempty)
  right' :: forall i a b c.
IxForget r i a b -> IxForget r i (Either c a) (Either c b)
right' (IxForget i -> a -> r
k) = forall r i a b. (i -> a -> r) -> IxForget r i a b
IxForget forall a b. (a -> b) -> a -> b
$ \i
i -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Monoid a => a
mempty) (i -> a -> r
k i
i)

instance Choice (IxForgetM r) where
  left' :: forall i a b c.
IxForgetM r i a b -> IxForgetM r i (Either a c) (Either b c)
left'  (IxForgetM i -> a -> Maybe r
k) = forall r i a b. (i -> a -> Maybe r) -> IxForgetM r i a b
IxForgetM forall a b. (a -> b) -> a -> b
$ \i
i -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (i -> a -> Maybe r
k i
i) (forall a b. a -> b -> a
const forall a. Maybe a
Nothing)
  right' :: forall i a b c.
IxForgetM r i a b -> IxForgetM r i (Either c a) (Either c b)
right' (IxForgetM i -> a -> Maybe r
k) = forall r i a b. (i -> a -> Maybe r) -> IxForgetM r i a b
IxForgetM forall a b. (a -> b) -> a -> b
$ \i
i -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) (i -> a -> Maybe r
k i
i)

instance Choice IxFunArrow where
  left' :: forall i a b c.
IxFunArrow i a b -> IxFunArrow i (Either a c) (Either b c)
left'  (IxFunArrow i -> a -> b
k) = forall i a b. (i -> a -> b) -> IxFunArrow i a b
IxFunArrow forall a b. (a -> b) -> a -> b
$ \i
i -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> a -> b
k i
i) forall a b. b -> Either a b
Right
  right' :: forall i a b c.
IxFunArrow i a b -> IxFunArrow i (Either c a) (Either c b)
right' (IxFunArrow i -> a -> b
k) = forall i a b. (i -> a -> b) -> IxFunArrow i a b
IxFunArrow forall a b. (a -> b) -> a -> b
$ \i
i -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a b. a -> Either a b
Left (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> a -> b
k i
i)

----------------------------------------

class Profunctor p => Cochoice p where
  unleft  :: p i (Either a d) (Either b d) -> p i a b
  unright :: p i (Either d a) (Either d b) -> p i a b

instance Cochoice (Forget r) where
  unleft :: forall i a d b.
Forget r i (Either a d) (Either b d) -> Forget r i a b
unleft  (Forget Either a d -> r
k) = forall r i a b. (a -> r) -> Forget r i a b
Forget (Either a d -> r
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left)
  unright :: forall i d a b.
Forget r i (Either d a) (Either d b) -> Forget r i a b
unright (Forget Either d a -> r
k) = forall r i a b. (a -> r) -> Forget r i a b
Forget (Either d a -> r
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right)

instance Cochoice (ForgetM r) where
  unleft :: forall i a d b.
ForgetM r i (Either a d) (Either b d) -> ForgetM r i a b
unleft  (ForgetM Either a d -> Maybe r
k) = forall r i a b. (a -> Maybe r) -> ForgetM r i a b
ForgetM (Either a d -> Maybe r
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left)
  unright :: forall i d a b.
ForgetM r i (Either d a) (Either d b) -> ForgetM r i a b
unright (ForgetM Either d a -> Maybe r
k) = forall r i a b. (a -> Maybe r) -> ForgetM r i a b
ForgetM (Either d a -> Maybe r
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right)

instance Cochoice (IxForget r) where
  unleft :: forall i a d b.
IxForget r i (Either a d) (Either b d) -> IxForget r i a b
unleft  (IxForget i -> Either a d -> r
k) = forall r i a b. (i -> a -> r) -> IxForget r i a b
IxForget forall a b. (a -> b) -> a -> b
$ \i
i -> i -> Either a d -> r
k i
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left
  unright :: forall i d a b.
IxForget r i (Either d a) (Either d b) -> IxForget r i a b
unright (IxForget i -> Either d a -> r
k) = forall r i a b. (i -> a -> r) -> IxForget r i a b
IxForget forall a b. (a -> b) -> a -> b
$ \i
i -> i -> Either d a -> r
k i
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right

instance Cochoice (IxForgetM r) where
  unleft :: forall i a d b.
IxForgetM r i (Either a d) (Either b d) -> IxForgetM r i a b
unleft  (IxForgetM i -> Either a d -> Maybe r
k) = forall r i a b. (i -> a -> Maybe r) -> IxForgetM r i a b
IxForgetM (\i
i -> i -> Either a d -> Maybe r
k i
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left)
  unright :: forall i d a b.
IxForgetM r i (Either d a) (Either d b) -> IxForgetM r i a b
unright (IxForgetM i -> Either d a -> Maybe r
k) = forall r i a b. (i -> a -> Maybe r) -> IxForgetM r i a b
IxForgetM (\i
i -> i -> Either d a -> Maybe r
k i
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right)

----------------------------------------

class (Choice p, Strong p) => Visiting p where
  visit
    :: forall i s t a b
    . (forall f. Functor f => (forall r. r -> f r) -> (a -> f b) -> s -> f t)
    -> p i a b
    -> p i s t
  visit forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (a -> f b) -> s -> f t
f =
    let match :: s -> Either a t
        match :: s -> Either a t
match s
s = forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (a -> f b) -> s -> f t
f forall a b. b -> Either a b
Right forall a b. a -> Either a b
Left s
s
        update :: s -> b -> t
        update :: s -> b -> t
update s
s b
b = forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (a -> f b) -> s -> f t
f forall a. a -> Identity a
Identity (\a
_ -> forall a. a -> Identity a
Identity b
b) s
s
    in forall (p :: * -> * -> * -> *) a b c d i.
Profunctor p =>
(a -> b) -> (c -> d) -> p i b c -> p i a d
dimap (\s
s -> (s -> Either a t
match s
s, s
s))
             (\(Either b t
ebt, s
s) -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (s -> b -> t
update s
s) forall a. a -> a
id Either b t
ebt)
       forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> * -> *) i a b c.
Strong p =>
p i a b -> p i (a, c) (b, c)
first'
       forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> * -> *) i a b c.
Choice p =>
p i a b -> p i (Either a c) (Either b c)
left'
  {-# INLINE visit #-}

  ivisit
    :: (forall f. Functor f => (forall r. r -> f r) -> (i -> a -> f b) -> s -> f t)
    -> p       j  a b
    -> p (i -> j) s t
  default ivisit
    :: Coercible (p j s t) (p (i -> j) s t)
    => (forall f. Functor f => (forall r. r -> f r) -> (i -> a -> f b) -> s -> f t)
    -> p       j  a b
    -> p (i -> j) s t
  ivisit forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (i -> a -> f b) -> s -> f t
f = coerce :: forall a b. Coercible a b => a -> b
coerce forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> * -> *) i s t a b.
Visiting p =>
(forall (f :: * -> *).
 Functor f =>
 (forall r. r -> f r) -> (a -> f b) -> s -> f t)
-> p i a b -> p i s t
visit (\forall r. r -> f r
point a -> f b
afb -> forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (i -> a -> f b) -> s -> f t
f forall r. r -> f r
point forall a b. (a -> b) -> a -> b
$ \i
_ -> a -> f b
afb)


instance Functor f => Visiting (StarA f) where
  visit :: forall i s t a b.
(forall (f :: * -> *).
 Functor f =>
 (forall r. r -> f r) -> (a -> f b) -> s -> f t)
-> StarA f i a b -> StarA f i s t
visit  forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (a -> f b) -> s -> f t
f (StarA forall r. r -> f r
point a -> f b
k) = forall (f :: * -> *) i a b.
(forall r. r -> f r) -> (a -> f b) -> StarA f i a b
StarA forall r. r -> f r
point forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (a -> f b) -> s -> f t
f forall r. r -> f r
point a -> f b
k
  ivisit :: forall i a b s t j.
(forall (f :: * -> *).
 Functor f =>
 (forall r. r -> f r) -> (i -> a -> f b) -> s -> f t)
-> StarA f j a b -> StarA f (i -> j) s t
ivisit forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (i -> a -> f b) -> s -> f t
f (StarA forall r. r -> f r
point a -> f b
k) = forall (f :: * -> *) i a b.
(forall r. r -> f r) -> (a -> f b) -> StarA f i a b
StarA forall r. r -> f r
point forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (i -> a -> f b) -> s -> f t
f forall r. r -> f r
point (\i
_ -> a -> f b
k)

instance Applicative f => Visiting (Star f) where
  visit :: forall i s t a b.
(forall (f :: * -> *).
 Functor f =>
 (forall r. r -> f r) -> (a -> f b) -> s -> f t)
-> Star f i a b -> Star f i s t
visit  forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (a -> f b) -> s -> f t
f (Star a -> f b
k) = forall (f :: * -> *) i a b. (a -> f b) -> Star f i a b
Star forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (a -> f b) -> s -> f t
f forall (f :: * -> *) a. Applicative f => a -> f a
pure a -> f b
k
  ivisit :: forall i a b s t j.
(forall (f :: * -> *).
 Functor f =>
 (forall r. r -> f r) -> (i -> a -> f b) -> s -> f t)
-> Star f j a b -> Star f (i -> j) s t
ivisit forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (i -> a -> f b) -> s -> f t
f (Star a -> f b
k) = forall (f :: * -> *) i a b. (a -> f b) -> Star f i a b
Star forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (i -> a -> f b) -> s -> f t
f forall (f :: * -> *) a. Applicative f => a -> f a
pure (\i
_ -> a -> f b
k)

instance Monoid r => Visiting (Forget r) where
  visit :: forall i s t a b.
(forall (f :: * -> *).
 Functor f =>
 (forall r. r -> f r) -> (a -> f b) -> s -> f t)
-> Forget r i a b -> Forget r i s t
visit  forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (a -> f b) -> s -> f t
f (Forget a -> r
k) = forall r i a b. (a -> r) -> Forget r i a b
Forget forall a b. (a -> b) -> a -> b
$ forall {k} a (b :: k). Const a b -> a
getConst forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (a -> f b) -> s -> f t
f forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall {k} a (b :: k). a -> Const a b
Const forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. a -> r
k)
  ivisit :: forall i a b s t j.
(forall (f :: * -> *).
 Functor f =>
 (forall r. r -> f r) -> (i -> a -> f b) -> s -> f t)
-> Forget r j a b -> Forget r (i -> j) s t
ivisit forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (i -> a -> f b) -> s -> f t
f (Forget a -> r
k) = forall r i a b. (a -> r) -> Forget r i a b
Forget forall a b. (a -> b) -> a -> b
$ forall {k} a (b :: k). Const a b -> a
getConst forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (i -> a -> f b) -> s -> f t
f forall (f :: * -> *) a. Applicative f => a -> f a
pure (\i
_ -> forall {k} a (b :: k). a -> Const a b
Const forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. a -> r
k)

instance Visiting (ForgetM r) where
  visit :: forall i s t a b.
(forall (f :: * -> *).
 Functor f =>
 (forall r. r -> f r) -> (a -> f b) -> s -> f t)
-> ForgetM r i a b -> ForgetM r i s t
visit  forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (a -> f b) -> s -> f t
f (ForgetM a -> Maybe r
k) =
    forall r i a b. (a -> Maybe r) -> ForgetM r i a b
ForgetM forall a b. (a -> b) -> a -> b
$ forall {k} a (b :: k). Const a b -> a
getConst forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (a -> f b) -> s -> f t
f (\r
_ -> forall {k} a (b :: k). a -> Const a b
Const forall a. Maybe a
Nothing) (forall {k} a (b :: k). a -> Const a b
Const forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. a -> Maybe r
k)
  ivisit :: forall i a b s t j.
(forall (f :: * -> *).
 Functor f =>
 (forall r. r -> f r) -> (i -> a -> f b) -> s -> f t)
-> ForgetM r j a b -> ForgetM r (i -> j) s t
ivisit forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (i -> a -> f b) -> s -> f t
f (ForgetM a -> Maybe r
k) =
    forall r i a b. (a -> Maybe r) -> ForgetM r i a b
ForgetM forall a b. (a -> b) -> a -> b
$ forall {k} a (b :: k). Const a b -> a
getConst forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (i -> a -> f b) -> s -> f t
f (\r
_ -> forall {k} a (b :: k). a -> Const a b
Const forall a. Maybe a
Nothing) (\i
_ -> forall {k} a (b :: k). a -> Const a b
Const forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. a -> Maybe r
k)

instance Visiting FunArrow where
  visit :: forall i s t a b.
(forall (f :: * -> *).
 Functor f =>
 (forall r. r -> f r) -> (a -> f b) -> s -> f t)
-> FunArrow i a b -> FunArrow i s t
visit  forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (a -> f b) -> s -> f t
f (FunArrow a -> b
k) = forall i a b. (a -> b) -> FunArrow i a b
FunArrow forall a b. (a -> b) -> a -> b
$ forall a. Identity a -> a
runIdentity forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (a -> f b) -> s -> f t
f forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Identity a
Identity forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. a -> b
k)
  ivisit :: forall i a b s t j.
(forall (f :: * -> *).
 Functor f =>
 (forall r. r -> f r) -> (i -> a -> f b) -> s -> f t)
-> FunArrow j a b -> FunArrow (i -> j) s t
ivisit forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (i -> a -> f b) -> s -> f t
f (FunArrow a -> b
k) = forall i a b. (a -> b) -> FunArrow i a b
FunArrow forall a b. (a -> b) -> a -> b
$ forall a. Identity a -> a
runIdentity forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (i -> a -> f b) -> s -> f t
f forall (f :: * -> *) a. Applicative f => a -> f a
pure (\i
_ -> forall a. a -> Identity a
Identity forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. a -> b
k)

instance Functor f => Visiting (IxStarA f) where
  visit :: forall i s t a b.
(forall (f :: * -> *).
 Functor f =>
 (forall r. r -> f r) -> (a -> f b) -> s -> f t)
-> IxStarA f i a b -> IxStarA f i s t
visit  forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (a -> f b) -> s -> f t
f (IxStarA forall r. r -> f r
point i -> a -> f b
k) = forall (f :: * -> *) i a b.
(forall r. r -> f r) -> (i -> a -> f b) -> IxStarA f i a b
IxStarA forall r. r -> f r
point forall a b. (a -> b) -> a -> b
$ \i
i  -> forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (a -> f b) -> s -> f t
f forall r. r -> f r
point (i -> a -> f b
k i
i)
  ivisit :: forall i a b s t j.
(forall (f :: * -> *).
 Functor f =>
 (forall r. r -> f r) -> (i -> a -> f b) -> s -> f t)
-> IxStarA f j a b -> IxStarA f (i -> j) s t
ivisit forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (i -> a -> f b) -> s -> f t
f (IxStarA forall r. r -> f r
point j -> a -> f b
k) = forall (f :: * -> *) i a b.
(forall r. r -> f r) -> (i -> a -> f b) -> IxStarA f i a b
IxStarA forall r. r -> f r
point forall a b. (a -> b) -> a -> b
$ \i -> j
ij -> forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (i -> a -> f b) -> s -> f t
f forall r. r -> f r
point forall a b. (a -> b) -> a -> b
$ \i
i -> j -> a -> f b
k (i -> j
ij i
i)

instance Applicative f => Visiting (IxStar f) where
  visit :: forall i s t a b.
(forall (f :: * -> *).
 Functor f =>
 (forall r. r -> f r) -> (a -> f b) -> s -> f t)
-> IxStar f i a b -> IxStar f i s t
visit  forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (a -> f b) -> s -> f t
f (IxStar i -> a -> f b
k) = forall (f :: * -> *) i a b. (i -> a -> f b) -> IxStar f i a b
IxStar forall a b. (a -> b) -> a -> b
$ \i
i  -> forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (a -> f b) -> s -> f t
f forall (f :: * -> *) a. Applicative f => a -> f a
pure (i -> a -> f b
k i
i)
  ivisit :: forall i a b s t j.
(forall (f :: * -> *).
 Functor f =>
 (forall r. r -> f r) -> (i -> a -> f b) -> s -> f t)
-> IxStar f j a b -> IxStar f (i -> j) s t
ivisit forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (i -> a -> f b) -> s -> f t
f (IxStar j -> a -> f b
k) = forall (f :: * -> *) i a b. (i -> a -> f b) -> IxStar f i a b
IxStar forall a b. (a -> b) -> a -> b
$ \i -> j
ij -> forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (i -> a -> f b) -> s -> f t
f forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ \i
i -> j -> a -> f b
k (i -> j
ij i
i)

instance Monoid r => Visiting (IxForget r) where
  visit :: forall i s t a b.
(forall (f :: * -> *).
 Functor f =>
 (forall r. r -> f r) -> (a -> f b) -> s -> f t)
-> IxForget r i a b -> IxForget r i s t
visit  forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (a -> f b) -> s -> f t
f (IxForget i -> a -> r
k) =
    forall r i a b. (i -> a -> r) -> IxForget r i a b
IxForget forall a b. (a -> b) -> a -> b
$ \i
i  -> forall {k} a (b :: k). Const a b -> a
getConst forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (a -> f b) -> s -> f t
f forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall {k} a (b :: k). a -> Const a b
Const forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. i -> a -> r
k i
i)
  ivisit :: forall i a b s t j.
(forall (f :: * -> *).
 Functor f =>
 (forall r. r -> f r) -> (i -> a -> f b) -> s -> f t)
-> IxForget r j a b -> IxForget r (i -> j) s t
ivisit forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (i -> a -> f b) -> s -> f t
f (IxForget j -> a -> r
k) =
    forall r i a b. (i -> a -> r) -> IxForget r i a b
IxForget forall a b. (a -> b) -> a -> b
$ \i -> j
ij -> forall {k} a (b :: k). Const a b -> a
getConst forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (i -> a -> f b) -> s -> f t
f forall (f :: * -> *) a. Applicative f => a -> f a
pure (\i
i -> forall {k} a (b :: k). a -> Const a b
Const forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. j -> a -> r
k (i -> j
ij i
i))

instance Visiting (IxForgetM r) where
  visit :: forall i s t a b.
(forall (f :: * -> *).
 Functor f =>
 (forall r. r -> f r) -> (a -> f b) -> s -> f t)
-> IxForgetM r i a b -> IxForgetM r i s t
visit  forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (a -> f b) -> s -> f t
f (IxForgetM i -> a -> Maybe r
k) =
    forall r i a b. (i -> a -> Maybe r) -> IxForgetM r i a b
IxForgetM forall a b. (a -> b) -> a -> b
$ \i
i  -> forall {k} a (b :: k). Const a b -> a
getConst forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (a -> f b) -> s -> f t
f (\r
_ -> forall {k} a (b :: k). a -> Const a b
Const forall a. Maybe a
Nothing) (forall {k} a (b :: k). a -> Const a b
Const forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. i -> a -> Maybe r
k i
i)
  ivisit :: forall i a b s t j.
(forall (f :: * -> *).
 Functor f =>
 (forall r. r -> f r) -> (i -> a -> f b) -> s -> f t)
-> IxForgetM r j a b -> IxForgetM r (i -> j) s t
ivisit forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (i -> a -> f b) -> s -> f t
f (IxForgetM j -> a -> Maybe r
k) =
    forall r i a b. (i -> a -> Maybe r) -> IxForgetM r i a b
IxForgetM forall a b. (a -> b) -> a -> b
$ \i -> j
ij -> forall {k} a (b :: k). Const a b -> a
getConst forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (i -> a -> f b) -> s -> f t
f (\r
_ -> forall {k} a (b :: k). a -> Const a b
Const forall a. Maybe a
Nothing) (\i
i -> forall {k} a (b :: k). a -> Const a b
Const forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. j -> a -> Maybe r
k (i -> j
ij i
i))

instance Visiting IxFunArrow where
  visit :: forall i s t a b.
(forall (f :: * -> *).
 Functor f =>
 (forall r. r -> f r) -> (a -> f b) -> s -> f t)
-> IxFunArrow i a b -> IxFunArrow i s t
visit  forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (a -> f b) -> s -> f t
f (IxFunArrow i -> a -> b
k) =
    forall i a b. (i -> a -> b) -> IxFunArrow i a b
IxFunArrow forall a b. (a -> b) -> a -> b
$ \i
i  -> forall a. Identity a -> a
runIdentity forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (a -> f b) -> s -> f t
f forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Identity a
Identity forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. i -> a -> b
k i
i)
  ivisit :: forall i a b s t j.
(forall (f :: * -> *).
 Functor f =>
 (forall r. r -> f r) -> (i -> a -> f b) -> s -> f t)
-> IxFunArrow j a b -> IxFunArrow (i -> j) s t
ivisit forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (i -> a -> f b) -> s -> f t
f (IxFunArrow j -> a -> b
k) =
    forall i a b. (i -> a -> b) -> IxFunArrow i a b
IxFunArrow forall a b. (a -> b) -> a -> b
$ \i -> j
ij -> forall a. Identity a -> a
runIdentity forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (i -> a -> f b) -> s -> f t
f forall (f :: * -> *) a. Applicative f => a -> f a
pure (\i
i -> forall a. a -> Identity a
Identity forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. j -> a -> b
k (i -> j
ij i
i))

----------------------------------------

class Visiting p => Traversing p where
  wander
    :: (forall f. Applicative f => (a -> f b) -> s -> f t)
    -> p i a b
    -> p i s t
  iwander
    :: (forall f. Applicative f => (i -> a -> f b) -> s -> f t)
    -> p       j  a b
    -> p (i -> j) s t

instance Applicative f => Traversing (Star f) where
  wander :: forall a b s t i.
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> Star f i a b -> Star f i s t
wander  forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t
f (Star a -> f b
k) = forall (f :: * -> *) i a b. (a -> f b) -> Star f i a b
Star forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t
f a -> f b
k
  iwander :: forall i a b s t j.
(forall (f :: * -> *).
 Applicative f =>
 (i -> a -> f b) -> s -> f t)
-> Star f j a b -> Star f (i -> j) s t
iwander forall (f :: * -> *). Applicative f => (i -> a -> f b) -> s -> f t
f (Star a -> f b
k) = forall (f :: * -> *) i a b. (a -> f b) -> Star f i a b
Star forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Applicative f => (i -> a -> f b) -> s -> f t
f (\i
_ -> a -> f b
k)

instance Monoid r => Traversing (Forget r) where
  wander :: forall a b s t i.
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> Forget r i a b -> Forget r i s t
wander  forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t
f (Forget a -> r
k) = forall r i a b. (a -> r) -> Forget r i a b
Forget forall a b. (a -> b) -> a -> b
$ forall {k} a (b :: k). Const a b -> a
getConst forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t
f (forall {k} a (b :: k). a -> Const a b
Const forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. a -> r
k)
  iwander :: forall i a b s t j.
(forall (f :: * -> *).
 Applicative f =>
 (i -> a -> f b) -> s -> f t)
-> Forget r j a b -> Forget r (i -> j) s t
iwander forall (f :: * -> *). Applicative f => (i -> a -> f b) -> s -> f t
f (Forget a -> r
k) = forall r i a b. (a -> r) -> Forget r i a b
Forget forall a b. (a -> b) -> a -> b
$ forall {k} a (b :: k). Const a b -> a
getConst forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall (f :: * -> *). Applicative f => (i -> a -> f b) -> s -> f t
f (\i
_ -> forall {k} a (b :: k). a -> Const a b
Const forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. a -> r
k)

instance Traversing FunArrow where
  wander :: forall a b s t i.
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> FunArrow i a b -> FunArrow i s t
wander  forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t
f (FunArrow a -> b
k) = forall i a b. (a -> b) -> FunArrow i a b
FunArrow forall a b. (a -> b) -> a -> b
$ forall a. Identity a -> a
runIdentity forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t
f (forall a. a -> Identity a
Identity forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. a -> b
k)
  iwander :: forall i a b s t j.
(forall (f :: * -> *).
 Applicative f =>
 (i -> a -> f b) -> s -> f t)
-> FunArrow j a b -> FunArrow (i -> j) s t
iwander forall (f :: * -> *). Applicative f => (i -> a -> f b) -> s -> f t
f (FunArrow a -> b
k) = forall i a b. (a -> b) -> FunArrow i a b
FunArrow forall a b. (a -> b) -> a -> b
$ forall a. Identity a -> a
runIdentity forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall (f :: * -> *). Applicative f => (i -> a -> f b) -> s -> f t
f (\i
_ -> forall a. a -> Identity a
Identity forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. a -> b
k)

instance Applicative f => Traversing (IxStar f) where
  wander :: forall a b s t i.
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> IxStar f i a b -> IxStar f i s t
wander  forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t
f (IxStar i -> a -> f b
k) = forall (f :: * -> *) i a b. (i -> a -> f b) -> IxStar f i a b
IxStar forall a b. (a -> b) -> a -> b
$ \i
i -> forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t
f (i -> a -> f b
k i
i)
  iwander :: forall i a b s t j.
(forall (f :: * -> *).
 Applicative f =>
 (i -> a -> f b) -> s -> f t)
-> IxStar f j a b -> IxStar f (i -> j) s t
iwander forall (f :: * -> *). Applicative f => (i -> a -> f b) -> s -> f t
f (IxStar j -> a -> f b
k) = forall (f :: * -> *) i a b. (i -> a -> f b) -> IxStar f i a b
IxStar forall a b. (a -> b) -> a -> b
$ \i -> j
ij -> forall (f :: * -> *). Applicative f => (i -> a -> f b) -> s -> f t
f forall a b. (a -> b) -> a -> b
$ \i
i -> j -> a -> f b
k (i -> j
ij i
i)

instance Monoid r => Traversing (IxForget r) where
  wander :: forall a b s t i.
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> IxForget r i a b -> IxForget r i s t
wander  forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t
f (IxForget i -> a -> r
k) =
    forall r i a b. (i -> a -> r) -> IxForget r i a b
IxForget forall a b. (a -> b) -> a -> b
$ \i
i -> forall {k} a (b :: k). Const a b -> a
getConst forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t
f (forall {k} a (b :: k). a -> Const a b
Const forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. i -> a -> r
k i
i)
  iwander :: forall i a b s t j.
(forall (f :: * -> *).
 Applicative f =>
 (i -> a -> f b) -> s -> f t)
-> IxForget r j a b -> IxForget r (i -> j) s t
iwander forall (f :: * -> *). Applicative f => (i -> a -> f b) -> s -> f t
f (IxForget j -> a -> r
k) =
    forall r i a b. (i -> a -> r) -> IxForget r i a b
IxForget forall a b. (a -> b) -> a -> b
$ \i -> j
ij -> forall {k} a (b :: k). Const a b -> a
getConst forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall (f :: * -> *). Applicative f => (i -> a -> f b) -> s -> f t
f (\i
i -> forall {k} a (b :: k). a -> Const a b
Const forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. j -> a -> r
k (i -> j
ij i
i))

instance Traversing IxFunArrow where
  wander :: forall a b s t i.
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> IxFunArrow i a b -> IxFunArrow i s t
wander  forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t
f (IxFunArrow i -> a -> b
k) =
    forall i a b. (i -> a -> b) -> IxFunArrow i a b
IxFunArrow forall a b. (a -> b) -> a -> b
$ \i
i -> forall a. Identity a -> a
runIdentity forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t
f (forall a. a -> Identity a
Identity forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. i -> a -> b
k i
i)
  iwander :: forall i a b s t j.
(forall (f :: * -> *).
 Applicative f =>
 (i -> a -> f b) -> s -> f t)
-> IxFunArrow j a b -> IxFunArrow (i -> j) s t
iwander forall (f :: * -> *). Applicative f => (i -> a -> f b) -> s -> f t
f (IxFunArrow j -> a -> b
k) =
    forall i a b. (i -> a -> b) -> IxFunArrow i a b
IxFunArrow forall a b. (a -> b) -> a -> b
$ \i -> j
ij -> forall a. Identity a -> a
runIdentity forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall (f :: * -> *). Applicative f => (i -> a -> f b) -> s -> f t
f (\i
i -> forall a. a -> Identity a
Identity forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. j -> a -> b
k (i -> j
ij i
i))

----------------------------------------

class Traversing p => Mapping p where
  roam
    :: ((a -> b) -> s -> t)
    -> p i a b
    -> p i s t
  iroam
    :: ((i -> a -> b) -> s -> t)
    -> p       j  a b
    -> p (i -> j) s t

instance Mapping FunArrow where
  roam :: forall a b s t i.
((a -> b) -> s -> t) -> FunArrow i a b -> FunArrow i s t
roam  (a -> b) -> s -> t
f (FunArrow a -> b
k) = forall i a b. (a -> b) -> FunArrow i a b
FunArrow forall a b. (a -> b) -> a -> b
$ (a -> b) -> s -> t
f a -> b
k
  iroam :: forall i a b s t j.
((i -> a -> b) -> s -> t)
-> FunArrow j a b -> FunArrow (i -> j) s t
iroam (i -> a -> b) -> s -> t
f (FunArrow a -> b
k) = forall i a b. (a -> b) -> FunArrow i a b
FunArrow forall a b. (a -> b) -> a -> b
$ (i -> a -> b) -> s -> t
f (forall a b. a -> b -> a
const a -> b
k)

instance Mapping IxFunArrow where
  roam :: forall a b s t i.
((a -> b) -> s -> t) -> IxFunArrow i a b -> IxFunArrow i s t
roam  (a -> b) -> s -> t
f (IxFunArrow i -> a -> b
k) = forall i a b. (i -> a -> b) -> IxFunArrow i a b
IxFunArrow forall a b. (a -> b) -> a -> b
$ \i
i -> (a -> b) -> s -> t
f (i -> a -> b
k i
i)
  iroam :: forall i a b s t j.
((i -> a -> b) -> s -> t)
-> IxFunArrow j a b -> IxFunArrow (i -> j) s t
iroam (i -> a -> b) -> s -> t
f (IxFunArrow j -> a -> b
k) = forall i a b. (i -> a -> b) -> IxFunArrow i a b
IxFunArrow forall a b. (a -> b) -> a -> b
$ \i -> j
ij -> (i -> a -> b) -> s -> t
f forall a b. (a -> b) -> a -> b
$ \i
i -> j -> a -> b
k (i -> j
ij i
i)


  -- | Type to represent the components of an isomorphism.
data Exchange a b i s t =
  Exchange (s -> a) (b -> t)

instance Profunctor (Exchange a b) where
  dimap :: forall a b c d i.
(a -> b) -> (c -> d) -> Exchange a b i b c -> Exchange a b i a d
dimap a -> b
ss c -> d
tt (Exchange b -> a
sa b -> c
bt) = forall a b i s t. (s -> a) -> (b -> t) -> Exchange a b i s t
Exchange (b -> a
sa forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
ss) (c -> d
tt forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> c
bt)
  lmap :: forall a b i c.
(a -> b) -> Exchange a b i b c -> Exchange a b i a c
lmap  a -> b
ss    (Exchange b -> a
sa b -> c
bt) = forall a b i s t. (s -> a) -> (b -> t) -> Exchange a b i s t
Exchange (b -> a
sa forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
ss) b -> c
bt
  rmap :: forall c d i b.
(c -> d) -> Exchange a b i b c -> Exchange a b i b d
rmap     c -> d
tt (Exchange b -> a
sa b -> c
bt) = forall a b i s t. (s -> a) -> (b -> t) -> Exchange a b i s t
Exchange b -> a
sa        (c -> d
tt forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> c
bt)

-- | Type to represent the components of a lens.
data Store a b i s t = Store (s -> a) (s -> b -> t)

instance Profunctor (Store a b) where
  dimap :: forall a b c d i.
(a -> b) -> (c -> d) -> Store a b i b c -> Store a b i a d
dimap a -> b
f c -> d
g (Store b -> a
get b -> b -> c
set) = forall a b i s t. (s -> a) -> (s -> b -> t) -> Store a b i s t
Store (b -> a
get forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) (\a
s -> c -> d
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> b -> c
set (a -> b
f a
s))
  lmap :: forall a b i c. (a -> b) -> Store a b i b c -> Store a b i a c
lmap  a -> b
f   (Store b -> a
get b -> b -> c
set) = forall a b i s t. (s -> a) -> (s -> b -> t) -> Store a b i s t
Store (b -> a
get forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) (\a
s -> b -> b -> c
set (a -> b
f a
s))
  rmap :: forall c d i b. (c -> d) -> Store a b i b c -> Store a b i b d
rmap    c -> d
g (Store b -> a
get b -> b -> c
set) = forall a b i s t. (s -> a) -> (s -> b -> t) -> Store a b i s t
Store b -> a
get       (\b
s -> c -> d
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> b -> c
set b
s)

instance Strong (Store a b) where
  first' :: forall i a b c. Store a b i a b -> Store a b i (a, c) (b, c)
first' (Store a -> a
get a -> b -> b
set) = forall a b i s t. (s -> a) -> (s -> b -> t) -> Store a b i s t
Store (a -> a
get forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) (\(a
s, c
c) b
b -> (a -> b -> b
set a
s b
b, c
c))
  second' :: forall i a b c. Store a b i a b -> Store a b i (c, a) (c, b)
second' (Store a -> a
get a -> b -> b
set) = forall a b i s t. (s -> a) -> (s -> b -> t) -> Store a b i s t
Store (a -> a
get forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (\(c
c, a
s) b
b -> (c
c, a -> b -> b
set a
s b
b))

-- | Type to represent the components of a prism.
data Market a b i s t = Market (b -> t) (s -> Either t a)

instance Functor (Market a b i s) where
  fmap :: forall a b. (a -> b) -> Market a b i s a -> Market a b i s b
fmap a -> b
f (Market b -> a
bt s -> Either a a
seta) = forall a b i s t. (b -> t) -> (s -> Either t a) -> Market a b i s t
Market (a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
bt) (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Either a a
seta)

instance Profunctor (Market a b) where
  dimap :: forall a b c d i.
(a -> b) -> (c -> d) -> Market a b i b c -> Market a b i a d
dimap a -> b
f c -> d
g (Market b -> c
bt b -> Either c a
seta) = forall a b i s t. (b -> t) -> (s -> Either t a) -> Market a b i s t
Market (c -> d
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> c
bt) (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> d
g) forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either c a
seta forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  lmap :: forall a b i c. (a -> b) -> Market a b i b c -> Market a b i a c
lmap  a -> b
f   (Market b -> c
bt b -> Either c a
seta) = forall a b i s t. (b -> t) -> (s -> Either t a) -> Market a b i s t
Market b -> c
bt (b -> Either c a
seta forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  rmap :: forall c d i b. (c -> d) -> Market a b i b c -> Market a b i b d
rmap    c -> d
g (Market b -> c
bt b -> Either c a
seta) = forall a b i s t. (b -> t) -> (s -> Either t a) -> Market a b i s t
Market (c -> d
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> c
bt) (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> d
g) forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either c a
seta)

instance Choice (Market a b) where
  left' :: forall i a b c.
Market a b i a b -> Market a b i (Either a c) (Either b c)
left' (Market b -> b
bt a -> Either b a
seta) = forall a b i s t. (b -> t) -> (s -> Either t a) -> Market a b i s t
Market (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> b
bt) forall a b. (a -> b) -> a -> b
$ \Either a c
sc -> case Either a c
sc of
    Left a
s -> case a -> Either b a
seta a
s of
      Left b
t -> forall a b. a -> Either a b
Left (forall a b. a -> Either a b
Left b
t)
      Right a
a -> forall a b. b -> Either a b
Right a
a
    Right c
c -> forall a b. a -> Either a b
Left (forall a b. b -> Either a b
Right c
c)
  right' :: forall i a b c.
Market a b i a b -> Market a b i (Either c a) (Either c b)
right' (Market b -> b
bt a -> Either b a
seta) = forall a b i s t. (b -> t) -> (s -> Either t a) -> Market a b i s t
Market (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> b
bt) forall a b. (a -> b) -> a -> b
$ \Either c a
cs -> case Either c a
cs of
    Left c
c -> forall a b. a -> Either a b
Left (forall a b. a -> Either a b
Left c
c)
    Right a
s -> case a -> Either b a
seta a
s of
      Left b
t -> forall a b. a -> Either a b
Left (forall a b. b -> Either a b
Right b
t)
      Right a
a -> forall a b. b -> Either a b
Right a
a

-- | Type to represent the components of an affine traversal.
data AffineMarket a b i s t = AffineMarket (s -> b -> t) (s -> Either t a)

instance Profunctor (AffineMarket a b) where
  dimap :: forall a b c d i.
(a -> b)
-> (c -> d) -> AffineMarket a b i b c -> AffineMarket a b i a d
dimap a -> b
f c -> d
g (AffineMarket b -> b -> c
sbt b -> Either c a
seta) = forall a b i s t.
(s -> b -> t) -> (s -> Either t a) -> AffineMarket a b i s t
AffineMarket
    (\a
s b
b -> c -> d
g (b -> b -> c
sbt (a -> b
f a
s) b
b))
    (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> d
g) forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either c a
seta forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  lmap :: forall a b i c.
(a -> b) -> AffineMarket a b i b c -> AffineMarket a b i a c
lmap a -> b
f (AffineMarket b -> b -> c
sbt b -> Either c a
seta) = forall a b i s t.
(s -> b -> t) -> (s -> Either t a) -> AffineMarket a b i s t
AffineMarket
    (\a
s b
b -> b -> b -> c
sbt (a -> b
f a
s) b
b)
    (b -> Either c a
seta forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  rmap :: forall c d i b.
(c -> d) -> AffineMarket a b i b c -> AffineMarket a b i b d
rmap c -> d
g (AffineMarket b -> b -> c
sbt b -> Either c a
seta) = forall a b i s t.
(s -> b -> t) -> (s -> Either t a) -> AffineMarket a b i s t
AffineMarket
    (\b
s b
b -> c -> d
g (b -> b -> c
sbt b
s b
b))
    (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> d
g) forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either c a
seta)

instance Choice (AffineMarket a b) where
  left' :: forall i a b c.
AffineMarket a b i a b
-> AffineMarket a b i (Either a c) (Either b c)
left' (AffineMarket a -> b -> b
sbt a -> Either b a
seta) = forall a b i s t.
(s -> b -> t) -> (s -> Either t a) -> AffineMarket a b i s t
AffineMarket
    (\Either a c
e b
b -> forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
bimap (forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> b -> b
sbt b
b) forall a. a -> a
id Either a c
e)
    (\Either a c
sc -> case Either a c
sc of
      Left a
s -> forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
bimap forall a b. a -> Either a b
Left forall a. a -> a
id (a -> Either b a
seta a
s)
      Right c
c -> forall a b. a -> Either a b
Left (forall a b. b -> Either a b
Right c
c))
  right' :: forall i a b c.
AffineMarket a b i a b
-> AffineMarket a b i (Either c a) (Either c b)
right' (AffineMarket a -> b -> b
sbt a -> Either b a
seta) = forall a b i s t.
(s -> b -> t) -> (s -> Either t a) -> AffineMarket a b i s t
AffineMarket
    (\Either c a
e b
b -> forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
bimap forall a. a -> a
id (forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> b -> b
sbt b
b) Either c a
e)
    (\Either c a
sc -> case Either c a
sc of
      Left c
c -> forall a b. a -> Either a b
Left (forall a b. a -> Either a b
Left c
c)
      Right a
s -> forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
bimap forall a b. b -> Either a b
Right forall a. a -> a
id (a -> Either b a
seta a
s))

instance Strong (AffineMarket a b) where
  first' :: forall i a b c.
AffineMarket a b i a b -> AffineMarket a b i (a, c) (b, c)
first' (AffineMarket a -> b -> b
sbt a -> Either b a
seta) = forall a b i s t.
(s -> b -> t) -> (s -> Either t a) -> AffineMarket a b i s t
AffineMarket
    (\(a
a, c
c) b
b -> (a -> b -> b
sbt a
a b
b, c
c))
    (\(a
a, c
c) -> forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
bimap (,c
c) forall a. a -> a
id (a -> Either b a
seta a
a))
  second' :: forall i a b c.
AffineMarket a b i a b -> AffineMarket a b i (c, a) (c, b)
second' (AffineMarket a -> b -> b
sbt a -> Either b a
seta) = forall a b i s t.
(s -> b -> t) -> (s -> Either t a) -> AffineMarket a b i s t
AffineMarket
    (\(c
c, a
a) b
b -> (c
c, a -> b -> b
sbt a
a b
b))
    (\(c
c, a
a) -> forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
bimap (c
c,) forall a. a -> a
id (a -> Either b a
seta a
a))

bimap :: (a -> b) -> (c -> d) -> Either a c -> Either b d
bimap :: forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
bimap a -> b
f c -> d
g = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> d
g)

instance Visiting (AffineMarket a b)

-- | Tag a value with not one but two phantom type parameters (so that 'Tagged'
-- can be used as an indexed profunctor).
newtype Tagged i a b = Tagged { forall i a b. Tagged i a b -> b
unTagged :: b }

instance Functor (Tagged i a) where
  fmap :: forall a b. (a -> b) -> Tagged i a a -> Tagged i a b
fmap a -> b
f = forall i a b. b -> Tagged i a b
Tagged forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. a -> b
f forall a b c. Coercible a b => (b -> c) -> (a -> b) -> a -> c
.# forall i a b. Tagged i a b -> b
unTagged

instance Profunctor Tagged where
  dimap :: forall a b c d i.
(a -> b) -> (c -> d) -> Tagged i b c -> Tagged i a d
dimap a -> b
_f c -> d
g = forall i a b. b -> Tagged i a b
Tagged forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. c -> d
g forall a b c. Coercible a b => (b -> c) -> (a -> b) -> a -> c
.# forall i a b. Tagged i a b -> b
unTagged
  lmap :: forall a b i c. (a -> b) -> Tagged i b c -> Tagged i a c
lmap  a -> b
_f   = coerce :: forall a b. Coercible a b => a -> b
coerce
  rmap :: forall c d i b. (c -> d) -> Tagged i b c -> Tagged i b d
rmap     c -> d
g = forall i a b. b -> Tagged i a b
Tagged forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. c -> d
g forall a b c. Coercible a b => (b -> c) -> (a -> b) -> a -> c
.# forall i a b. Tagged i a b -> b
unTagged

instance Choice Tagged where
  left' :: forall i a b c. Tagged i a b -> Tagged i (Either a c) (Either b c)
left'  = forall i a b. b -> Tagged i a b
Tagged forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall a b. a -> Either a b
Left  forall a b c. Coercible a b => (b -> c) -> (a -> b) -> a -> c
.# forall i a b. Tagged i a b -> b
unTagged
  right' :: forall i a b c. Tagged i a b -> Tagged i (Either c a) (Either c b)
right' = forall i a b. b -> Tagged i a b
Tagged forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. forall a b. b -> Either a b
Right forall a b c. Coercible a b => (b -> c) -> (a -> b) -> a -> c
.# forall i a b. Tagged i a b -> b
unTagged

instance Costrong Tagged where
  unfirst :: forall i a d b. Tagged i (a, d) (b, d) -> Tagged i a b
unfirst (Tagged (b, d)
bd) = forall i a b. b -> Tagged i a b
Tagged (forall a b. (a, b) -> a
fst (b, d)
bd)
  unsecond :: forall i d a b. Tagged i (d, a) (d, b) -> Tagged i a b
unsecond (Tagged (d, b)
db) = forall i a b. b -> Tagged i a b
Tagged (forall a b. (a, b) -> b
snd (d, b)
db)


data Context a b t = Context (b -> t) a
  deriving forall a b. a -> Context a b b -> Context a b a
forall a b. (a -> b) -> Context a b a -> Context a b b
forall a b a b. a -> Context a b b -> Context a b a
forall a b a b. (a -> b) -> Context a b a -> Context a b b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Context a b b -> Context a b a
$c<$ :: forall a b a b. a -> Context a b b -> Context a b a
fmap :: forall a b. (a -> b) -> Context a b a -> Context a b b
$cfmap :: forall a b a b. (a -> b) -> Context a b a -> Context a b b
Functor

-- | Composition operator where the first argument must be an identity
-- function up to representational equivalence (e.g. a newtype wrapper
-- or unwrapper), and will be ignored at runtime.
(#.) :: Coercible b c => (b -> c) -> (a -> b) -> (a -> c)
#. :: forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
(#.) b -> c
_f = coerce :: forall a b. Coercible a b => a -> b
coerce
infixl 8 .#
{-# INLINE (.#) #-}

-- | Composition operator where the second argument must be an
-- identity function up to representational equivalence (e.g. a
-- newtype wrapper or unwrapper), and will be ignored at runtime.
(.#) :: Coercible a b => (b -> c) -> (a -> b) -> (a -> c)
.# :: forall a b c. Coercible a b => (b -> c) -> (a -> b) -> a -> c
(.#) b -> c
f a -> b
_g = coerce :: forall a b. Coercible a b => a -> b
coerce b -> c
f
infixr 9 #.
{-# INLINE (#.) #-}