{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# 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 { Star f i a b -> a -> f b
runStar :: a -> f b }

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

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

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

-- | Needed for indexed traversals.
newtype IxStar f i a b = IxStar { 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 { IxForget r i a b -> i -> a -> r
runIxForget :: i -> a -> r }

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

-- | Needed for indexed setters.
newtype IxFunArrow i a b = IxFunArrow { 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 :: 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 :: 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 :: Star f i a b -> Star f j a b
reStar (Star a -> f b
k) = (a -> f b) -> Star f j a b
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 :: Forget r i a b -> Forget r j a b
reForget (Forget a -> r
k) = (a -> r) -> Forget r j a b
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 :: FunArrow i a b -> FunArrow j a b
reFunArrow (FunArrow a -> b
k) = (a -> b) -> FunArrow j a b
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' = p i a c -> p i b c
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' = p i c a -> p i c 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
_ = p i s t -> p j s t
coerce (p i s t -> p j s t) -> (p i a b -> p i s t) -> p i a b -> p j s t
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
_ = p i a b -> p j 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 :: p i c a -> p i c b
rcoerce = p i c a -> p i c b
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 :: p i a c -> p i b c
lcoerce = p i a c -> p i b c
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 :: (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 r. r -> f r) -> (a -> f d) -> StarA f i a d
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 ((c -> d) -> f c -> f d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g (f c -> f d) -> (a -> f c) -> a -> f d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> f c
k (b -> f c) -> (a -> b) -> a -> f c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  lmap :: (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 r. r -> f r) -> (a -> f c) -> StarA f i a c
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 (b -> f c) -> (a -> b) -> a -> f c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  rmap :: (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 r. r -> f r) -> (b -> f d) -> StarA f i b d
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 ((c -> d) -> f c -> f d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g (f c -> f d) -> (b -> f c) -> b -> f d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> f c
k)

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

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

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

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

instance Profunctor (ForgetM r) where
  dimap :: (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) = (a -> Maybe r) -> ForgetM r i a d
forall r i a b. (a -> Maybe r) -> ForgetM r i a b
ForgetM (b -> Maybe r
k (b -> Maybe r) -> (a -> b) -> a -> Maybe r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  lmap :: (a -> b) -> ForgetM r i b c -> ForgetM r i a c
lmap  a -> b
f   (ForgetM b -> Maybe r
k) = (a -> Maybe r) -> ForgetM r i a c
forall r i a b. (a -> Maybe r) -> ForgetM r i a b
ForgetM (b -> Maybe r
k (b -> Maybe r) -> (a -> b) -> a -> Maybe r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  rmap :: (c -> d) -> ForgetM r i b c -> ForgetM r i b d
rmap   c -> d
_g (ForgetM b -> Maybe r
k) = (b -> Maybe r) -> ForgetM r i b d
forall r i a b. (a -> Maybe r) -> ForgetM r i a b
ForgetM b -> Maybe r
k

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

instance Functor f => Profunctor (IxStarA f) where
  dimap :: (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 r. r -> f r) -> (i -> a -> f d) -> IxStarA f i a d
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 -> (c -> d) -> f c -> f d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g (f c -> f d) -> (a -> f c) -> a -> f d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> b -> f c
k i
i (b -> f c) -> (a -> b) -> a -> f c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  lmap :: (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 r. r -> f r) -> (i -> a -> f c) -> IxStarA f i a c
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 (b -> f c) -> (a -> b) -> a -> f c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  rmap :: (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 r. r -> f r) -> (i -> b -> f d) -> IxStarA f i b d
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 -> (c -> d) -> f c -> f d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g (f c -> f d) -> (b -> f c) -> b -> f d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> b -> f c
k i
i)

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

  conjoined__ :: (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 :: (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 r. r -> f r) -> (j -> a -> f b) -> IxStarA f j a b
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 ((j -> a -> f b) -> IxStarA f j a b)
-> (j -> a -> f b) -> IxStarA f j a b
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 :: (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) = (i -> a -> f d) -> IxStar f i a d
forall (f :: * -> *) i a b. (i -> a -> f b) -> IxStar f i a b
IxStar (\i
i -> (c -> d) -> f c -> f d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g (f c -> f d) -> (a -> f c) -> a -> f d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> b -> f c
k i
i (b -> f c) -> (a -> b) -> a -> f c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  lmap :: (a -> b) -> IxStar f i b c -> IxStar f i a c
lmap  a -> b
f   (IxStar i -> b -> f c
k) = (i -> a -> f c) -> IxStar f i a c
forall (f :: * -> *) i a b. (i -> a -> f b) -> IxStar f i a b
IxStar (\i
i -> i -> b -> f c
k i
i (b -> f c) -> (a -> b) -> a -> f c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  rmap :: (c -> d) -> IxStar f i b c -> IxStar f i b d
rmap    c -> d
g (IxStar i -> b -> f c
k) = (i -> b -> f d) -> IxStar f i b d
forall (f :: * -> *) i a b. (i -> a -> f b) -> IxStar f i a b
IxStar (\i
i -> (c -> d) -> f c -> f d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g (f c -> f d) -> (b -> f c) -> b -> f d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> b -> f c
k i
i)

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

  conjoined__ :: (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 :: (j -> i) -> IxStar f i a b -> IxStar f j a b
ixcontramap j -> i
ij (IxStar i -> a -> f b
k) = (j -> a -> f b) -> IxStar f j a b
forall (f :: * -> *) i a b. (i -> a -> f b) -> IxStar f i a b
IxStar ((j -> a -> f b) -> IxStar f j a b)
-> (j -> a -> f b) -> IxStar f j a b
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 :: (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) = (i -> a -> r) -> IxForget r i a d
forall r i a b. (i -> a -> r) -> IxForget r i a b
IxForget (\i
i -> i -> b -> r
k i
i (b -> r) -> (a -> b) -> a -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  lmap :: (a -> b) -> IxForget r i b c -> IxForget r i a c
lmap  a -> b
f   (IxForget i -> b -> r
k) = (i -> a -> r) -> IxForget r i a c
forall r i a b. (i -> a -> r) -> IxForget r i a b
IxForget (\i
i -> i -> b -> r
k i
i (b -> r) -> (a -> b) -> a -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  rmap :: (c -> d) -> IxForget r i b c -> IxForget r i b d
rmap   c -> d
_g (IxForget i -> b -> r
k) = (i -> b -> r) -> IxForget r i b d
forall r i a b. (i -> a -> r) -> IxForget r i a b
IxForget i -> b -> r
k

  conjoined__ :: (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 :: (j -> i) -> IxForget r i a b -> IxForget r j a b
ixcontramap j -> i
ij (IxForget i -> a -> r
k) = (j -> a -> r) -> IxForget r j a b
forall r i a b. (i -> a -> r) -> IxForget r i a b
IxForget ((j -> a -> r) -> IxForget r j a b)
-> (j -> a -> r) -> IxForget r j a b
forall a b. (a -> b) -> a -> b
$ \j
i -> i -> a -> r
k (j -> i
ij j
i)

instance Profunctor (IxForgetM r) where
  dimap :: (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) = (i -> a -> Maybe r) -> IxForgetM r i a d
forall r i a b. (i -> a -> Maybe r) -> IxForgetM r i a b
IxForgetM (\i
i -> i -> b -> Maybe r
k i
i (b -> Maybe r) -> (a -> b) -> a -> Maybe r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  lmap :: (a -> b) -> IxForgetM r i b c -> IxForgetM r i a c
lmap  a -> b
f   (IxForgetM i -> b -> Maybe r
k) = (i -> a -> Maybe r) -> IxForgetM r i a c
forall r i a b. (i -> a -> Maybe r) -> IxForgetM r i a b
IxForgetM (\i
i -> i -> b -> Maybe r
k i
i (b -> Maybe r) -> (a -> b) -> a -> Maybe r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  rmap :: (c -> d) -> IxForgetM r i b c -> IxForgetM r i b d
rmap   c -> d
_g (IxForgetM i -> b -> Maybe r
k) = (i -> b -> Maybe r) -> IxForgetM r i b d
forall r i a b. (i -> a -> Maybe r) -> IxForgetM r i a b
IxForgetM i -> b -> Maybe r
k

  conjoined__ :: (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 :: (j -> i) -> IxForgetM r i a b -> IxForgetM r j a b
ixcontramap j -> i
ij (IxForgetM i -> a -> Maybe r
k) = (j -> a -> Maybe r) -> IxForgetM r j a b
forall r i a b. (i -> a -> Maybe r) -> IxForgetM r i a b
IxForgetM ((j -> a -> Maybe r) -> IxForgetM r j a b)
-> (j -> a -> Maybe r) -> IxForgetM r j a b
forall a b. (a -> b) -> a -> b
$ \j
i -> i -> a -> Maybe r
k (j -> i
ij j
i)

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

  conjoined__ :: (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 :: (j -> i) -> IxFunArrow i a b -> IxFunArrow j a b
ixcontramap j -> i
ij (IxFunArrow i -> a -> b
k) = (j -> a -> b) -> IxFunArrow j a b
forall i a b. (i -> a -> b) -> IxFunArrow i a b
IxFunArrow ((j -> a -> b) -> IxFunArrow j a b)
-> (j -> a -> b) -> IxFunArrow j a b
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 = (s -> (a, b -> t))
-> ((b, b -> t) -> t) -> p i (a, b -> t) (b, b -> t) -> p i s t
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)) (Context a b t -> (a, b -> t))
-> (s -> Context a b t) -> s -> (a, b -> t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Context a b b) -> s -> Context a b t
forall (f :: * -> *). Functor f => (a -> f b) -> s -> f t
f ((b -> b) -> a -> Context a b b
forall a b t. (b -> t) -> a -> Context a b t
Context b -> b
forall a. a -> a
id))
    (\(b
b, b -> t
bt) -> b -> t
bt b
b)
    (p i (a, b -> t) (b, b -> t) -> p i s t)
-> (p i a b -> p i (a, b -> t) (b, b -> t)) -> p i a b -> p i s t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p i a b -> p i (a, b -> t) (b, b -> t)
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 = p j s t -> p (i -> j) s t
coerce (p j s t -> p (i -> j) s t)
-> (p j a b -> p j s t) -> p j a b -> p (i -> j) s t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (f :: * -> *). Functor f => (a -> f b) -> s -> f t)
-> p j a b -> p j s t
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 -> (i -> a -> f b) -> s -> f t
forall (f :: * -> *). Functor f => (i -> a -> f b) -> s -> f t
f ((i -> a -> f b) -> s -> f t) -> (i -> a -> f b) -> s -> f t
forall a b. (a -> b) -> a -> b
$ \i
_ -> a -> f b
afb)

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

  linear :: (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 r. r -> f r) -> (s -> f t) -> StarA f i s t
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 ((a -> f b) -> s -> f t
forall (f :: * -> *). Functor f => (a -> f b) -> s -> f t
f a -> f b
k)

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

  linear :: (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) = (s -> f t) -> Star f i s t
forall (f :: * -> *) i a b. (a -> f b) -> Star f i a b
Star ((a -> f b) -> s -> f t
forall (f :: * -> *). Functor f => (a -> f b) -> s -> f t
f a -> f b
k)

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

  linear :: (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) = (s -> r) -> Forget r i s t
forall r i a b. (a -> r) -> Forget r i a b
Forget (Const r t -> r
forall a k (b :: k). Const a b -> a
getConst (Const r t -> r) -> (s -> Const r t) -> s -> r
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (a -> Const r b) -> s -> Const r t
forall (f :: * -> *). Functor f => (a -> f b) -> s -> f t
f (r -> Const r b
forall k a (b :: k). a -> Const a b
Const (r -> Const r b) -> (a -> r) -> a -> Const r b
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. a -> r
k))

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

  linear :: (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) = (s -> Maybe r) -> ForgetM r i s t
forall r i a b. (a -> Maybe r) -> ForgetM r i a b
ForgetM (Const (Maybe r) t -> Maybe r
forall a k (b :: k). Const a b -> a
getConst (Const (Maybe r) t -> Maybe r)
-> (s -> Const (Maybe r) t) -> s -> Maybe r
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (a -> Const (Maybe r) b) -> s -> Const (Maybe r) t
forall (f :: * -> *). Functor f => (a -> f b) -> s -> f t
f (Maybe r -> Const (Maybe r) b
forall k a (b :: k). a -> Const a b
Const (Maybe r -> Const (Maybe r) b)
-> (a -> Maybe r) -> a -> Const (Maybe r) b
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. a -> Maybe r
k))

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

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

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

  linear :: (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 r. r -> f r) -> (i -> s -> f t) -> IxStarA f i s t
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 -> s -> f t) -> IxStarA f i s t)
-> (i -> s -> f t) -> IxStarA f i s t
forall a b. (a -> b) -> a -> b
$ \i
i -> (a -> f b) -> s -> f t
forall (f :: * -> *). Functor f => (a -> f b) -> s -> f t
f (i -> a -> f b
k i
i)
  ilinear :: (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 r. r -> f r)
-> ((i -> j) -> s -> f t) -> IxStarA f (i -> j) s t
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 -> j) -> s -> f t) -> IxStarA f (i -> j) s t)
-> ((i -> j) -> s -> f t) -> IxStarA f (i -> j) s t
forall a b. (a -> b) -> a -> b
$ \i -> j
ij -> (i -> a -> f b) -> s -> f t
forall (f :: * -> *). Functor f => (i -> a -> f b) -> s -> f t
f ((i -> a -> f b) -> s -> f t) -> (i -> a -> f b) -> s -> f t
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' :: IxStar f i a b -> IxStar f i (a, c) (b, c)
first'  (IxStar i -> a -> f b
k) = (i -> (a, c) -> f (b, c)) -> IxStar f i (a, c) (b, c)
forall (f :: * -> *) i a b. (i -> a -> f b) -> IxStar f i a b
IxStar ((i -> (a, c) -> f (b, c)) -> IxStar f i (a, c) (b, c))
-> (i -> (a, c) -> f (b, c)) -> IxStar f i (a, c) (b, c)
forall a b. (a -> b) -> a -> b
$ \i
i ~(a
a, c
c) -> (\b
b' -> (b
b', c
c)) (b -> (b, c)) -> f b -> f (b, c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> i -> a -> f b
k i
i a
a
  second' :: IxStar f i a b -> IxStar f i (c, a) (c, b)
second' (IxStar i -> a -> f b
k) = (i -> (c, a) -> f (c, b)) -> IxStar f i (c, a) (c, b)
forall (f :: * -> *) i a b. (i -> a -> f b) -> IxStar f i a b
IxStar ((i -> (c, a) -> f (c, b)) -> IxStar f i (c, a) (c, b))
-> (i -> (c, a) -> f (c, b)) -> IxStar f i (c, a) (c, b)
forall a b. (a -> b) -> a -> b
$ \i
i ~(c
c, a
a) -> (,) c
c (b -> (c, b)) -> f b -> f (c, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> i -> a -> f b
k i
i a
a

  linear :: (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) = (i -> s -> f t) -> IxStar f i s t
forall (f :: * -> *) i a b. (i -> a -> f b) -> IxStar f i a b
IxStar ((i -> s -> f t) -> IxStar f i s t)
-> (i -> s -> f t) -> IxStar f i s t
forall a b. (a -> b) -> a -> b
$ \i
i -> (a -> f b) -> s -> f t
forall (f :: * -> *). Functor f => (a -> f b) -> s -> f t
f (i -> a -> f b
k i
i)
  ilinear :: (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) = ((i -> j) -> s -> f t) -> IxStar f (i -> j) s t
forall (f :: * -> *) i a b. (i -> a -> f b) -> IxStar f i a b
IxStar (((i -> j) -> s -> f t) -> IxStar f (i -> j) s t)
-> ((i -> j) -> s -> f t) -> IxStar f (i -> j) s t
forall a b. (a -> b) -> a -> b
$ \i -> j
ij -> (i -> a -> f b) -> s -> f t
forall (f :: * -> *). Functor f => (i -> a -> f b) -> s -> f t
f ((i -> a -> f b) -> s -> f t) -> (i -> a -> f b) -> s -> f t
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' :: IxForget r i a b -> IxForget r i (a, c) (b, c)
first'  (IxForget i -> a -> r
k) = (i -> (a, c) -> r) -> IxForget r i (a, c) (b, c)
forall r i a b. (i -> a -> r) -> IxForget r i a b
IxForget ((i -> (a, c) -> r) -> IxForget r i (a, c) (b, c))
-> (i -> (a, c) -> r) -> IxForget r i (a, c) (b, c)
forall a b. (a -> b) -> a -> b
$ \i
i -> i -> a -> r
k i
i (a -> r) -> ((a, c) -> a) -> (a, c) -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, c) -> a
forall a b. (a, b) -> a
fst
  second' :: IxForget r i a b -> IxForget r i (c, a) (c, b)
second' (IxForget i -> a -> r
k) = (i -> (c, a) -> r) -> IxForget r i (c, a) (c, b)
forall r i a b. (i -> a -> r) -> IxForget r i a b
IxForget ((i -> (c, a) -> r) -> IxForget r i (c, a) (c, b))
-> (i -> (c, a) -> r) -> IxForget r i (c, a) (c, b)
forall a b. (a -> b) -> a -> b
$ \i
i -> i -> a -> r
k i
i (a -> r) -> ((c, a) -> a) -> (c, a) -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c, a) -> a
forall a b. (a, b) -> b
snd

  linear :: (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) = (i -> s -> r) -> IxForget r i s t
forall r i a b. (i -> a -> r) -> IxForget r i a b
IxForget ((i -> s -> r) -> IxForget r i s t)
-> (i -> s -> r) -> IxForget r i s t
forall a b. (a -> b) -> a -> b
$ \i
i -> Const r t -> r
forall a k (b :: k). Const a b -> a
getConst (Const r t -> r) -> (s -> Const r t) -> s -> r
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (a -> Const r b) -> s -> Const r t
forall (f :: * -> *). Functor f => (a -> f b) -> s -> f t
f (r -> Const r b
forall k a (b :: k). a -> Const a b
Const (r -> Const r b) -> (a -> r) -> a -> Const r b
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. i -> a -> r
k i
i)
  ilinear :: (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) = ((i -> j) -> s -> r) -> IxForget r (i -> j) s t
forall r i a b. (i -> a -> r) -> IxForget r i a b
IxForget (((i -> j) -> s -> r) -> IxForget r (i -> j) s t)
-> ((i -> j) -> s -> r) -> IxForget r (i -> j) s t
forall a b. (a -> b) -> a -> b
$ \i -> j
ij -> Const r t -> r
forall a k (b :: k). Const a b -> a
getConst (Const r t -> r) -> (s -> Const r t) -> s -> r
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (i -> a -> Const r b) -> s -> Const r t
forall (f :: * -> *). Functor f => (i -> a -> f b) -> s -> f t
f (\i
i -> r -> Const r b
forall k a (b :: k). a -> Const a b
Const (r -> Const r b) -> (a -> r) -> a -> Const r b
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' :: IxForgetM r i a b -> IxForgetM r i (a, c) (b, c)
first'  (IxForgetM i -> a -> Maybe r
k) = (i -> (a, c) -> Maybe r) -> IxForgetM r i (a, c) (b, c)
forall r i a b. (i -> a -> Maybe r) -> IxForgetM r i a b
IxForgetM ((i -> (a, c) -> Maybe r) -> IxForgetM r i (a, c) (b, c))
-> (i -> (a, c) -> Maybe r) -> IxForgetM r i (a, c) (b, c)
forall a b. (a -> b) -> a -> b
$ \i
i -> i -> a -> Maybe r
k i
i (a -> Maybe r) -> ((a, c) -> a) -> (a, c) -> Maybe r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, c) -> a
forall a b. (a, b) -> a
fst
  second' :: IxForgetM r i a b -> IxForgetM r i (c, a) (c, b)
second' (IxForgetM i -> a -> Maybe r
k) = (i -> (c, a) -> Maybe r) -> IxForgetM r i (c, a) (c, b)
forall r i a b. (i -> a -> Maybe r) -> IxForgetM r i a b
IxForgetM ((i -> (c, a) -> Maybe r) -> IxForgetM r i (c, a) (c, b))
-> (i -> (c, a) -> Maybe r) -> IxForgetM r i (c, a) (c, b)
forall a b. (a -> b) -> a -> b
$ \i
i -> i -> a -> Maybe r
k i
i (a -> Maybe r) -> ((c, a) -> a) -> (c, a) -> Maybe r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c, a) -> a
forall a b. (a, b) -> b
snd

  linear :: (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) = (i -> s -> Maybe r) -> IxForgetM r i s t
forall r i a b. (i -> a -> Maybe r) -> IxForgetM r i a b
IxForgetM ((i -> s -> Maybe r) -> IxForgetM r i s t)
-> (i -> s -> Maybe r) -> IxForgetM r i s t
forall a b. (a -> b) -> a -> b
$ \i
i -> Const (Maybe r) t -> Maybe r
forall a k (b :: k). Const a b -> a
getConst (Const (Maybe r) t -> Maybe r)
-> (s -> Const (Maybe r) t) -> s -> Maybe r
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (a -> Const (Maybe r) b) -> s -> Const (Maybe r) t
forall (f :: * -> *). Functor f => (a -> f b) -> s -> f t
f (Maybe r -> Const (Maybe r) b
forall k a (b :: k). a -> Const a b
Const (Maybe r -> Const (Maybe r) b)
-> (a -> Maybe r) -> a -> Const (Maybe r) b
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. i -> a -> Maybe r
k i
i)
  ilinear :: (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) = ((i -> j) -> s -> Maybe r) -> IxForgetM r (i -> j) s t
forall r i a b. (i -> a -> Maybe r) -> IxForgetM r i a b
IxForgetM (((i -> j) -> s -> Maybe r) -> IxForgetM r (i -> j) s t)
-> ((i -> j) -> s -> Maybe r) -> IxForgetM r (i -> j) s t
forall a b. (a -> b) -> a -> b
$ \i -> j
ij -> Const (Maybe r) t -> Maybe r
forall a k (b :: k). Const a b -> a
getConst (Const (Maybe r) t -> Maybe r)
-> (s -> Const (Maybe r) t) -> s -> Maybe r
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (i -> a -> Const (Maybe r) b) -> s -> Const (Maybe r) t
forall (f :: * -> *). Functor f => (i -> a -> f b) -> s -> f t
f (\i
i -> Maybe r -> Const (Maybe r) b
forall k a (b :: k). a -> Const a b
Const (Maybe r -> Const (Maybe r) b)
-> (a -> Maybe r) -> a -> Const (Maybe r) b
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' :: IxFunArrow i a b -> IxFunArrow i (a, c) (b, c)
first'  (IxFunArrow i -> a -> b
k) = (i -> (a, c) -> (b, c)) -> IxFunArrow i (a, c) (b, c)
forall i a b. (i -> a -> b) -> IxFunArrow i a b
IxFunArrow ((i -> (a, c) -> (b, c)) -> IxFunArrow i (a, c) (b, c))
-> (i -> (a, c) -> (b, c)) -> IxFunArrow i (a, c) (b, c)
forall a b. (a -> b) -> a -> b
$ \i
i ~(a
a, c
c) -> (i -> a -> b
k i
i a
a, c
c)
  second' :: IxFunArrow i a b -> IxFunArrow i (c, a) (c, b)
second' (IxFunArrow i -> a -> b
k) = (i -> (c, a) -> (c, b)) -> IxFunArrow i (c, a) (c, b)
forall i a b. (i -> a -> b) -> IxFunArrow i a b
IxFunArrow ((i -> (c, a) -> (c, b)) -> IxFunArrow i (c, a) (c, b))
-> (i -> (c, a) -> (c, b)) -> IxFunArrow i (c, a) (c, b)
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 (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) = (i -> s -> t) -> IxFunArrow i s t
forall i a b. (i -> a -> b) -> IxFunArrow i a b
IxFunArrow ((i -> s -> t) -> IxFunArrow i s t)
-> (i -> s -> t) -> IxFunArrow i s t
forall a b. (a -> b) -> a -> b
$ \i
i ->
    Identity t -> t
forall a. Identity a -> a
runIdentity (Identity t -> t) -> (s -> Identity t) -> s -> t
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (a -> Identity b) -> s -> Identity t
forall (f :: * -> *). Functor f => (a -> f b) -> s -> f t
f (b -> Identity b
forall a. a -> Identity a
Identity (b -> Identity b) -> (a -> b) -> a -> Identity b
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. i -> a -> b
k i
i)
  ilinear :: (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) = ((i -> j) -> s -> t) -> IxFunArrow (i -> j) s t
forall i a b. (i -> a -> b) -> IxFunArrow i a b
IxFunArrow (((i -> j) -> s -> t) -> IxFunArrow (i -> j) s t)
-> ((i -> j) -> s -> t) -> IxFunArrow (i -> j) s t
forall a b. (a -> b) -> a -> b
$ \i -> j
ij ->
    Identity t -> t
forall a. Identity a -> a
runIdentity (Identity t -> t) -> (s -> Identity t) -> s -> t
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (i -> a -> Identity b) -> s -> Identity t
forall (f :: * -> *). Functor f => (i -> a -> f b) -> s -> f t
f (\i
i -> b -> Identity b
forall a. a -> Identity a
Identity (b -> Identity b) -> (a -> b) -> a -> Identity b
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' :: 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 r. r -> f r)
-> (Either a c -> f (Either b c))
-> StarA f i (Either a c) (Either b c)
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 ((Either a c -> f (Either b c))
 -> StarA f i (Either a c) (Either b c))
-> (Either a c -> f (Either b c))
-> StarA f i (Either a c) (Either b c)
forall a b. (a -> b) -> a -> b
$ (a -> f (Either b c))
-> (c -> f (Either b c)) -> Either a c -> f (Either b c)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((b -> Either b c) -> f b -> f (Either b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Either b c
forall a b. a -> Either a b
Left (f b -> f (Either b c)) -> (a -> f b) -> a -> f (Either b c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f b
k) (Either b c -> f (Either b c)
forall r. r -> f r
point (Either b c -> f (Either b c))
-> (c -> Either b c) -> c -> f (Either b c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Either b c
forall a b. b -> Either a b
Right)
  right' :: 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 r. r -> f r)
-> (Either c a -> f (Either c b))
-> StarA f i (Either c a) (Either c b)
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 ((Either c a -> f (Either c b))
 -> StarA f i (Either c a) (Either c b))
-> (Either c a -> f (Either c b))
-> StarA f i (Either c a) (Either c b)
forall a b. (a -> b) -> a -> b
$ (c -> f (Either c b))
-> (a -> f (Either c b)) -> Either c a -> f (Either c b)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either c b -> f (Either c b)
forall r. r -> f r
point (Either c b -> f (Either c b))
-> (c -> Either c b) -> c -> f (Either c b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Either c b
forall a b. a -> Either a b
Left) ((b -> Either c b) -> f b -> f (Either c b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Either c b
forall a b. b -> Either a b
Right (f b -> f (Either c b)) -> (a -> f b) -> a -> f (Either c b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f b
k)

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

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

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

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

instance Functor f => Choice (IxStarA f) where
  left' :: 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 r. r -> f r)
-> (i -> Either a c -> f (Either b c))
-> IxStarA f i (Either a c) (Either b c)
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 -> Either a c -> f (Either b c))
 -> IxStarA f i (Either a c) (Either b c))
-> (i -> Either a c -> f (Either b c))
-> IxStarA f i (Either a c) (Either b c)
forall a b. (a -> b) -> a -> b
$ \i
i -> (a -> f (Either b c))
-> (c -> f (Either b c)) -> Either a c -> f (Either b c)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((b -> Either b c) -> f b -> f (Either b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Either b c
forall a b. a -> Either a b
Left (f b -> f (Either b c)) -> (a -> f b) -> a -> f (Either b c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> a -> f b
k i
i) (Either b c -> f (Either b c)
forall r. r -> f r
point (Either b c -> f (Either b c))
-> (c -> Either b c) -> c -> f (Either b c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Either b c
forall a b. b -> Either a b
Right)
  right' :: 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 r. r -> f r)
-> (i -> Either c a -> f (Either c b))
-> IxStarA f i (Either c a) (Either c b)
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 -> Either c a -> f (Either c b))
 -> IxStarA f i (Either c a) (Either c b))
-> (i -> Either c a -> f (Either c b))
-> IxStarA f i (Either c a) (Either c b)
forall a b. (a -> b) -> a -> b
$ \i
i -> (c -> f (Either c b))
-> (a -> f (Either c b)) -> Either c a -> f (Either c b)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either c b -> f (Either c b)
forall r. r -> f r
point (Either c b -> f (Either c b))
-> (c -> Either c b) -> c -> f (Either c b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Either c b
forall a b. a -> Either a b
Left) ((b -> Either c b) -> f b -> f (Either c b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Either c b
forall a b. b -> Either a b
Right (f b -> f (Either c b)) -> (a -> f b) -> a -> f (Either c b)
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' :: IxStar f i a b -> IxStar f i (Either a c) (Either b c)
left'  (IxStar i -> a -> f b
k) = (i -> Either a c -> f (Either b c))
-> IxStar f i (Either a c) (Either b c)
forall (f :: * -> *) i a b. (i -> a -> f b) -> IxStar f i a b
IxStar ((i -> Either a c -> f (Either b c))
 -> IxStar f i (Either a c) (Either b c))
-> (i -> Either a c -> f (Either b c))
-> IxStar f i (Either a c) (Either b c)
forall a b. (a -> b) -> a -> b
$ \i
i -> (a -> f (Either b c))
-> (c -> f (Either b c)) -> Either a c -> f (Either b c)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((b -> Either b c) -> f b -> f (Either b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Either b c
forall a b. a -> Either a b
Left (f b -> f (Either b c)) -> (a -> f b) -> a -> f (Either b c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> a -> f b
k i
i) (Either b c -> f (Either b c)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either b c -> f (Either b c))
-> (c -> Either b c) -> c -> f (Either b c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Either b c
forall a b. b -> Either a b
Right)
  right' :: IxStar f i a b -> IxStar f i (Either c a) (Either c b)
right' (IxStar i -> a -> f b
k) = (i -> Either c a -> f (Either c b))
-> IxStar f i (Either c a) (Either c b)
forall (f :: * -> *) i a b. (i -> a -> f b) -> IxStar f i a b
IxStar ((i -> Either c a -> f (Either c b))
 -> IxStar f i (Either c a) (Either c b))
-> (i -> Either c a -> f (Either c b))
-> IxStar f i (Either c a) (Either c b)
forall a b. (a -> b) -> a -> b
$ \i
i -> (c -> f (Either c b))
-> (a -> f (Either c b)) -> Either c a -> f (Either c b)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either c b -> f (Either c b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either c b -> f (Either c b))
-> (c -> Either c b) -> c -> f (Either c b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Either c b
forall a b. a -> Either a b
Left) ((b -> Either c b) -> f b -> f (Either c b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Either c b
forall a b. b -> Either a b
Right (f b -> f (Either c b)) -> (a -> f b) -> a -> f (Either c b)
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' :: IxForget r i a b -> IxForget r i (Either a c) (Either b c)
left'  (IxForget i -> a -> r
k) = (i -> Either a c -> r) -> IxForget r i (Either a c) (Either b c)
forall r i a b. (i -> a -> r) -> IxForget r i a b
IxForget ((i -> Either a c -> r) -> IxForget r i (Either a c) (Either b c))
-> (i -> Either a c -> r) -> IxForget r i (Either a c) (Either b c)
forall a b. (a -> b) -> a -> b
$ \i
i -> (a -> r) -> (c -> r) -> Either a c -> r
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (i -> a -> r
k i
i) (r -> c -> r
forall a b. a -> b -> a
const r
forall a. Monoid a => a
mempty)
  right' :: IxForget r i a b -> IxForget r i (Either c a) (Either c b)
right' (IxForget i -> a -> r
k) = (i -> Either c a -> r) -> IxForget r i (Either c a) (Either c b)
forall r i a b. (i -> a -> r) -> IxForget r i a b
IxForget ((i -> Either c a -> r) -> IxForget r i (Either c a) (Either c b))
-> (i -> Either c a -> r) -> IxForget r i (Either c a) (Either c b)
forall a b. (a -> b) -> a -> b
$ \i
i -> (c -> r) -> (a -> r) -> Either c a -> r
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (r -> c -> r
forall a b. a -> b -> a
const r
forall a. Monoid a => a
mempty) (i -> a -> r
k i
i)

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

instance Choice IxFunArrow where
  left' :: IxFunArrow i a b -> IxFunArrow i (Either a c) (Either b c)
left'  (IxFunArrow i -> a -> b
k) = (i -> Either a c -> Either b c)
-> IxFunArrow i (Either a c) (Either b c)
forall i a b. (i -> a -> b) -> IxFunArrow i a b
IxFunArrow ((i -> Either a c -> Either b c)
 -> IxFunArrow i (Either a c) (Either b c))
-> (i -> Either a c -> Either b c)
-> IxFunArrow i (Either a c) (Either b c)
forall a b. (a -> b) -> a -> b
$ \i
i -> (a -> Either b c) -> (c -> Either b c) -> Either a c -> Either b c
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (b -> Either b c
forall a b. a -> Either a b
Left (b -> Either b c) -> (a -> b) -> a -> Either b c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> a -> b
k i
i) c -> Either b c
forall a b. b -> Either a b
Right
  right' :: IxFunArrow i a b -> IxFunArrow i (Either c a) (Either c b)
right' (IxFunArrow i -> a -> b
k) = (i -> Either c a -> Either c b)
-> IxFunArrow i (Either c a) (Either c b)
forall i a b. (i -> a -> b) -> IxFunArrow i a b
IxFunArrow ((i -> Either c a -> Either c b)
 -> IxFunArrow i (Either c a) (Either c b))
-> (i -> Either c a -> Either c b)
-> IxFunArrow i (Either c a) (Either c b)
forall a b. (a -> b) -> a -> b
$ \i
i -> (c -> Either c b) -> (a -> Either c b) -> Either c a -> Either c b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either c -> Either c b
forall a b. a -> Either a b
Left (b -> Either c b
forall a b. b -> Either a b
Right (b -> Either c b) -> (a -> b) -> a -> Either c b
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 :: Forget r i (Either a d) (Either b d) -> Forget r i a b
unleft  (Forget Either a d -> r
k) = (a -> r) -> Forget r i a b
forall r i a b. (a -> r) -> Forget r i a b
Forget (Either a d -> r
k (Either a d -> r) -> (a -> Either a d) -> a -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a d
forall a b. a -> Either a b
Left)
  unright :: Forget r i (Either d a) (Either d b) -> Forget r i a b
unright (Forget Either d a -> r
k) = (a -> r) -> Forget r i a b
forall r i a b. (a -> r) -> Forget r i a b
Forget (Either d a -> r
k (Either d a -> r) -> (a -> Either d a) -> a -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either d a
forall a b. b -> Either a b
Right)

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

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

instance Cochoice (IxForgetM r) where
  unleft :: IxForgetM r i (Either a d) (Either b d) -> IxForgetM r i a b
unleft  (IxForgetM i -> Either a d -> Maybe r
k) = (i -> a -> Maybe r) -> IxForgetM r i a b
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 (Either a d -> Maybe r) -> (a -> Either a d) -> a -> Maybe r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a d
forall a b. a -> Either a b
Left)
  unright :: IxForgetM r i (Either d a) (Either d b) -> IxForgetM r i a b
unright (IxForgetM i -> Either d a -> Maybe r
k) = (i -> a -> Maybe r) -> IxForgetM r i a b
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 (Either d a -> Maybe r) -> (a -> Either d a) -> a -> Maybe r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either d a
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 r. r -> Either a r) -> (a -> Either a b) -> s -> Either a t
forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (a -> f b) -> s -> f t
f forall r. r -> Either a r
forall a b. b -> Either a b
Right a -> Either a b
forall a b. a -> Either a b
Left s
s
        update :: s -> b -> t
        update :: s -> b -> t
update s
s b
b = Identity t -> t
forall a. Identity a -> a
runIdentity (Identity t -> t) -> Identity t -> t
forall a b. (a -> b) -> a -> b
$ (forall a. a -> Identity a) -> (a -> Identity b) -> s -> Identity t
forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (a -> f b) -> s -> f t
f forall a. a -> Identity a
Identity (\a
_ -> b -> Identity b
forall a. a -> Identity a
Identity b
b) s
s
    in (s -> (Either a t, s))
-> ((Either b t, s) -> t)
-> p i (Either a t, s) (Either b t, s)
-> p i s t
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) -> (b -> t) -> (t -> t) -> Either b t -> t
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (s -> b -> t
update s
s) t -> t
forall a. a -> a
id Either b t
ebt)
       (p i (Either a t, s) (Either b t, s) -> p i s t)
-> (p i a b -> p i (Either a t, s) (Either b t, s))
-> p i a b
-> p i s t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p i (Either a t) (Either b t)
-> p i (Either a t, s) (Either b t, s)
forall (p :: * -> * -> * -> *) i a b c.
Strong p =>
p i a b -> p i (a, c) (b, c)
first'
       (p i (Either a t) (Either b t)
 -> p i (Either a t, s) (Either b t, s))
-> (p i a b -> p i (Either a t) (Either b t))
-> p i a b
-> p i (Either a t, s) (Either b t, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p i a b -> p i (Either a t) (Either b t)
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 = p j s t -> p (i -> j) s t
coerce (p j s t -> p (i -> j) s t)
-> (p j a b -> p j s t) -> p j a b -> p (i -> j) s t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (f :: * -> *).
 Functor f =>
 (forall r. r -> f r) -> (a -> f b) -> s -> f t)
-> p j a b -> p j s t
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 r. r -> f r) -> (i -> a -> f b) -> s -> f t
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) -> s -> f t) -> (i -> a -> f b) -> s -> f t
forall a b. (a -> b) -> a -> b
$ \i
_ -> a -> f b
afb)


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

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

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

instance Visiting FunArrow where
  visit :: (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) = (s -> t) -> FunArrow i s t
forall i a b. (a -> b) -> FunArrow i a b
FunArrow ((s -> t) -> FunArrow i s t) -> (s -> t) -> FunArrow i s t
forall a b. (a -> b) -> a -> b
$ Identity t -> t
forall a. Identity a -> a
runIdentity (Identity t -> t) -> (s -> Identity t) -> s -> t
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (forall a. a -> Identity a) -> (a -> Identity b) -> s -> Identity t
forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (a -> f b) -> s -> f t
f forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> Identity b
forall a. a -> Identity a
Identity (b -> Identity b) -> (a -> b) -> a -> Identity b
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. a -> b
k)
  ivisit :: (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) = (s -> t) -> FunArrow (i -> j) s t
forall i a b. (a -> b) -> FunArrow i a b
FunArrow ((s -> t) -> FunArrow (i -> j) s t)
-> (s -> t) -> FunArrow (i -> j) s t
forall a b. (a -> b) -> a -> b
$ Identity t -> t
forall a. Identity a -> a
runIdentity (Identity t -> t) -> (s -> Identity t) -> s -> t
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (forall a. a -> Identity a)
-> (i -> a -> Identity b) -> s -> Identity t
forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (i -> a -> f b) -> s -> f t
f forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (\i
_ -> b -> Identity b
forall a. a -> Identity a
Identity (b -> Identity b) -> (a -> b) -> a -> Identity b
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 (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 r. r -> f r) -> (i -> s -> f t) -> IxStarA f i s t
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 -> s -> f t) -> IxStarA f i s t)
-> (i -> s -> f t) -> IxStarA f i s t
forall a b. (a -> b) -> a -> b
$ \i
i  -> (forall r. r -> f r) -> (a -> f b) -> s -> f t
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 (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 r. r -> f r)
-> ((i -> j) -> s -> f t) -> IxStarA f (i -> j) s t
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 -> j) -> s -> f t) -> IxStarA f (i -> j) s t)
-> ((i -> j) -> s -> f t) -> IxStarA f (i -> j) s t
forall a b. (a -> b) -> a -> b
$ \i -> j
ij -> (forall r. r -> f r) -> (i -> a -> f b) -> s -> f t
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) -> s -> f t) -> (i -> a -> f b) -> s -> f t
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 (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) = (i -> s -> f t) -> IxStar f i s t
forall (f :: * -> *) i a b. (i -> a -> f b) -> IxStar f i a b
IxStar ((i -> s -> f t) -> IxStar f i s t)
-> (i -> s -> f t) -> IxStar f i s t
forall a b. (a -> b) -> a -> b
$ \i
i  -> (forall r. r -> f r) -> (a -> f b) -> s -> f t
forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (a -> f b) -> s -> f t
f forall r. r -> f r
forall (f :: * -> *) a. Applicative f => a -> f a
pure (i -> a -> f b
k i
i)
  ivisit :: (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) = ((i -> j) -> s -> f t) -> IxStar f (i -> j) s t
forall (f :: * -> *) i a b. (i -> a -> f b) -> IxStar f i a b
IxStar (((i -> j) -> s -> f t) -> IxStar f (i -> j) s t)
-> ((i -> j) -> s -> f t) -> IxStar f (i -> j) s t
forall a b. (a -> b) -> a -> b
$ \i -> j
ij -> (forall r. r -> f r) -> (i -> a -> f b) -> s -> f t
forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (i -> a -> f b) -> s -> f t
f forall r. r -> f r
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((i -> a -> f b) -> s -> f t) -> (i -> a -> f b) -> s -> f t
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 (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) =
    (i -> s -> r) -> IxForget r i s t
forall r i a b. (i -> a -> r) -> IxForget r i a b
IxForget ((i -> s -> r) -> IxForget r i s t)
-> (i -> s -> r) -> IxForget r i s t
forall a b. (a -> b) -> a -> b
$ \i
i  -> Const r t -> r
forall a k (b :: k). Const a b -> a
getConst (Const r t -> r) -> (s -> Const r t) -> s -> r
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (forall r. r -> Const r r) -> (a -> Const r b) -> s -> Const r t
forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (a -> f b) -> s -> f t
f forall r. r -> Const r r
forall (f :: * -> *) a. Applicative f => a -> f a
pure (r -> Const r b
forall k a (b :: k). a -> Const a b
Const (r -> Const r b) -> (a -> r) -> a -> Const r b
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. i -> a -> r
k i
i)
  ivisit :: (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) =
    ((i -> j) -> s -> r) -> IxForget r (i -> j) s t
forall r i a b. (i -> a -> r) -> IxForget r i a b
IxForget (((i -> j) -> s -> r) -> IxForget r (i -> j) s t)
-> ((i -> j) -> s -> r) -> IxForget r (i -> j) s t
forall a b. (a -> b) -> a -> b
$ \i -> j
ij -> Const r t -> r
forall a k (b :: k). Const a b -> a
getConst (Const r t -> r) -> (s -> Const r t) -> s -> r
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (forall r. r -> Const r r)
-> (i -> a -> Const r b) -> s -> Const r t
forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (i -> a -> f b) -> s -> f t
f forall r. r -> Const r r
forall (f :: * -> *) a. Applicative f => a -> f a
pure (\i
i -> r -> Const r b
forall k a (b :: k). a -> Const a b
Const (r -> Const r b) -> (a -> r) -> a -> Const r b
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 (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) =
    (i -> s -> Maybe r) -> IxForgetM r i s t
forall r i a b. (i -> a -> Maybe r) -> IxForgetM r i a b
IxForgetM ((i -> s -> Maybe r) -> IxForgetM r i s t)
-> (i -> s -> Maybe r) -> IxForgetM r i s t
forall a b. (a -> b) -> a -> b
$ \i
i  -> Const (Maybe r) t -> Maybe r
forall a k (b :: k). Const a b -> a
getConst (Const (Maybe r) t -> Maybe r)
-> (s -> Const (Maybe r) t) -> s -> Maybe r
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (forall r. r -> Const (Maybe r) r)
-> (a -> Const (Maybe r) b) -> s -> Const (Maybe r) t
forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (a -> f b) -> s -> f t
f (\r
_ -> Maybe r -> Const (Maybe r) r
forall k a (b :: k). a -> Const a b
Const Maybe r
forall a. Maybe a
Nothing) (Maybe r -> Const (Maybe r) b
forall k a (b :: k). a -> Const a b
Const (Maybe r -> Const (Maybe r) b)
-> (a -> Maybe r) -> a -> Const (Maybe r) b
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. i -> a -> Maybe r
k i
i)
  ivisit :: (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) =
    ((i -> j) -> s -> Maybe r) -> IxForgetM r (i -> j) s t
forall r i a b. (i -> a -> Maybe r) -> IxForgetM r i a b
IxForgetM (((i -> j) -> s -> Maybe r) -> IxForgetM r (i -> j) s t)
-> ((i -> j) -> s -> Maybe r) -> IxForgetM r (i -> j) s t
forall a b. (a -> b) -> a -> b
$ \i -> j
ij -> Const (Maybe r) t -> Maybe r
forall a k (b :: k). Const a b -> a
getConst (Const (Maybe r) t -> Maybe r)
-> (s -> Const (Maybe r) t) -> s -> Maybe r
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (forall r. r -> Const (Maybe r) r)
-> (i -> a -> Const (Maybe r) b) -> s -> Const (Maybe r) t
forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (i -> a -> f b) -> s -> f t
f (\r
_ -> Maybe r -> Const (Maybe r) r
forall k a (b :: k). a -> Const a b
Const Maybe r
forall a. Maybe a
Nothing) (\i
i -> Maybe r -> Const (Maybe r) b
forall k a (b :: k). a -> Const a b
Const (Maybe r -> Const (Maybe r) b)
-> (a -> Maybe r) -> a -> Const (Maybe r) b
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 (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) =
    (i -> s -> t) -> IxFunArrow i s t
forall i a b. (i -> a -> b) -> IxFunArrow i a b
IxFunArrow ((i -> s -> t) -> IxFunArrow i s t)
-> (i -> s -> t) -> IxFunArrow i s t
forall a b. (a -> b) -> a -> b
$ \i
i  -> Identity t -> t
forall a. Identity a -> a
runIdentity (Identity t -> t) -> (s -> Identity t) -> s -> t
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (forall a. a -> Identity a) -> (a -> Identity b) -> s -> Identity t
forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (a -> f b) -> s -> f t
f forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> Identity b
forall a. a -> Identity a
Identity (b -> Identity b) -> (a -> b) -> a -> Identity b
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. i -> a -> b
k i
i)
  ivisit :: (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) =
    ((i -> j) -> s -> t) -> IxFunArrow (i -> j) s t
forall i a b. (i -> a -> b) -> IxFunArrow i a b
IxFunArrow (((i -> j) -> s -> t) -> IxFunArrow (i -> j) s t)
-> ((i -> j) -> s -> t) -> IxFunArrow (i -> j) s t
forall a b. (a -> b) -> a -> b
$ \i -> j
ij -> Identity t -> t
forall a. Identity a -> a
runIdentity (Identity t -> t) -> (s -> Identity t) -> s -> t
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (forall a. a -> Identity a)
-> (i -> a -> Identity b) -> s -> Identity t
forall (f :: * -> *).
Functor f =>
(forall r. r -> f r) -> (i -> a -> f b) -> s -> f t
f forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (\i
i -> b -> Identity b
forall a. a -> Identity a
Identity (b -> Identity b) -> (a -> b) -> a -> Identity b
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 (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) = (s -> f t) -> Star f i s t
forall (f :: * -> *) i a b. (a -> f b) -> Star f i a b
Star ((s -> f t) -> Star f i s t) -> (s -> f t) -> Star f i s t
forall a b. (a -> b) -> a -> b
$ (a -> f b) -> s -> f t
forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t
f a -> f b
k
  iwander :: (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) = (s -> f t) -> Star f (i -> j) s t
forall (f :: * -> *) i a b. (a -> f b) -> Star f i a b
Star ((s -> f t) -> Star f (i -> j) s t)
-> (s -> f t) -> Star f (i -> j) s t
forall a b. (a -> b) -> a -> b
$ (i -> a -> f b) -> s -> f t
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 (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) = (s -> r) -> Forget r i s t
forall r i a b. (a -> r) -> Forget r i a b
Forget ((s -> r) -> Forget r i s t) -> (s -> r) -> Forget r i s t
forall a b. (a -> b) -> a -> b
$ Const r t -> r
forall a k (b :: k). Const a b -> a
getConst (Const r t -> r) -> (s -> Const r t) -> s -> r
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (a -> Const r b) -> s -> Const r t
forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t
f (r -> Const r b
forall k a (b :: k). a -> Const a b
Const (r -> Const r b) -> (a -> r) -> a -> Const r b
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. a -> r
k)
  iwander :: (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) = (s -> r) -> Forget r (i -> j) s t
forall r i a b. (a -> r) -> Forget r i a b
Forget ((s -> r) -> Forget r (i -> j) s t)
-> (s -> r) -> Forget r (i -> j) s t
forall a b. (a -> b) -> a -> b
$ Const r t -> r
forall a k (b :: k). Const a b -> a
getConst (Const r t -> r) -> (s -> Const r t) -> s -> r
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (i -> a -> Const r b) -> s -> Const r t
forall (f :: * -> *). Applicative f => (i -> a -> f b) -> s -> f t
f (\i
_ -> r -> Const r b
forall k a (b :: k). a -> Const a b
Const (r -> Const r b) -> (a -> r) -> a -> Const r b
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. a -> r
k)

instance Traversing FunArrow where
  wander :: (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) = (s -> t) -> FunArrow i s t
forall i a b. (a -> b) -> FunArrow i a b
FunArrow ((s -> t) -> FunArrow i s t) -> (s -> t) -> FunArrow i s t
forall a b. (a -> b) -> a -> b
$ Identity t -> t
forall a. Identity a -> a
runIdentity (Identity t -> t) -> (s -> Identity t) -> s -> t
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (a -> Identity b) -> s -> Identity t
forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t
f (b -> Identity b
forall a. a -> Identity a
Identity (b -> Identity b) -> (a -> b) -> a -> Identity b
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. a -> b
k)
  iwander :: (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) = (s -> t) -> FunArrow (i -> j) s t
forall i a b. (a -> b) -> FunArrow i a b
FunArrow ((s -> t) -> FunArrow (i -> j) s t)
-> (s -> t) -> FunArrow (i -> j) s t
forall a b. (a -> b) -> a -> b
$ Identity t -> t
forall a. Identity a -> a
runIdentity (Identity t -> t) -> (s -> Identity t) -> s -> t
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (i -> a -> Identity b) -> s -> Identity t
forall (f :: * -> *). Applicative f => (i -> a -> f b) -> s -> f t
f (\i
_ -> b -> Identity b
forall a. a -> Identity a
Identity (b -> Identity b) -> (a -> b) -> a -> Identity b
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 (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) = (i -> s -> f t) -> IxStar f i s t
forall (f :: * -> *) i a b. (i -> a -> f b) -> IxStar f i a b
IxStar ((i -> s -> f t) -> IxStar f i s t)
-> (i -> s -> f t) -> IxStar f i s t
forall a b. (a -> b) -> a -> b
$ \i
i -> (a -> f b) -> s -> f t
forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t
f (i -> a -> f b
k i
i)
  iwander :: (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) = ((i -> j) -> s -> f t) -> IxStar f (i -> j) s t
forall (f :: * -> *) i a b. (i -> a -> f b) -> IxStar f i a b
IxStar (((i -> j) -> s -> f t) -> IxStar f (i -> j) s t)
-> ((i -> j) -> s -> f t) -> IxStar f (i -> j) s t
forall a b. (a -> b) -> a -> b
$ \i -> j
ij -> (i -> a -> f b) -> s -> f t
forall (f :: * -> *). Applicative f => (i -> a -> f b) -> s -> f t
f ((i -> a -> f b) -> s -> f t) -> (i -> a -> f b) -> s -> f t
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 (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) =
    (i -> s -> r) -> IxForget r i s t
forall r i a b. (i -> a -> r) -> IxForget r i a b
IxForget ((i -> s -> r) -> IxForget r i s t)
-> (i -> s -> r) -> IxForget r i s t
forall a b. (a -> b) -> a -> b
$ \i
i -> Const r t -> r
forall a k (b :: k). Const a b -> a
getConst (Const r t -> r) -> (s -> Const r t) -> s -> r
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (a -> Const r b) -> s -> Const r t
forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t
f (r -> Const r b
forall k a (b :: k). a -> Const a b
Const (r -> Const r b) -> (a -> r) -> a -> Const r b
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. i -> a -> r
k i
i)
  iwander :: (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) =
    ((i -> j) -> s -> r) -> IxForget r (i -> j) s t
forall r i a b. (i -> a -> r) -> IxForget r i a b
IxForget (((i -> j) -> s -> r) -> IxForget r (i -> j) s t)
-> ((i -> j) -> s -> r) -> IxForget r (i -> j) s t
forall a b. (a -> b) -> a -> b
$ \i -> j
ij -> Const r t -> r
forall a k (b :: k). Const a b -> a
getConst (Const r t -> r) -> (s -> Const r t) -> s -> r
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (i -> a -> Const r b) -> s -> Const r t
forall (f :: * -> *). Applicative f => (i -> a -> f b) -> s -> f t
f (\i
i -> r -> Const r b
forall k a (b :: k). a -> Const a b
Const (r -> Const r b) -> (a -> r) -> a -> Const r b
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 (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) =
    (i -> s -> t) -> IxFunArrow i s t
forall i a b. (i -> a -> b) -> IxFunArrow i a b
IxFunArrow ((i -> s -> t) -> IxFunArrow i s t)
-> (i -> s -> t) -> IxFunArrow i s t
forall a b. (a -> b) -> a -> b
$ \i
i -> Identity t -> t
forall a. Identity a -> a
runIdentity (Identity t -> t) -> (s -> Identity t) -> s -> t
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (a -> Identity b) -> s -> Identity t
forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t
f (b -> Identity b
forall a. a -> Identity a
Identity (b -> Identity b) -> (a -> b) -> a -> Identity b
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. i -> a -> b
k i
i)
  iwander :: (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) =
    ((i -> j) -> s -> t) -> IxFunArrow (i -> j) s t
forall i a b. (i -> a -> b) -> IxFunArrow i a b
IxFunArrow (((i -> j) -> s -> t) -> IxFunArrow (i -> j) s t)
-> ((i -> j) -> s -> t) -> IxFunArrow (i -> j) s t
forall a b. (a -> b) -> a -> b
$ \i -> j
ij -> Identity t -> t
forall a. Identity a -> a
runIdentity (Identity t -> t) -> (s -> Identity t) -> s -> t
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (i -> a -> Identity b) -> s -> Identity t
forall (f :: * -> *). Applicative f => (i -> a -> f b) -> s -> f t
f (\i
i -> b -> Identity b
forall a. a -> Identity a
Identity (b -> Identity b) -> (a -> b) -> a -> Identity b
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 :: ((a -> b) -> s -> t) -> FunArrow i a b -> FunArrow i s t
roam  (a -> b) -> s -> t
f (FunArrow a -> b
k) = (s -> t) -> FunArrow i s t
forall i a b. (a -> b) -> FunArrow i a b
FunArrow ((s -> t) -> FunArrow i s t) -> (s -> t) -> FunArrow i s t
forall a b. (a -> b) -> a -> b
$ (a -> b) -> s -> t
f a -> b
k
  iroam :: ((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) = (s -> t) -> FunArrow (i -> j) s t
forall i a b. (a -> b) -> FunArrow i a b
FunArrow ((s -> t) -> FunArrow (i -> j) s t)
-> (s -> t) -> FunArrow (i -> j) s t
forall a b. (a -> b) -> a -> b
$ (i -> a -> b) -> s -> t
f ((a -> b) -> i -> a -> b
forall a b. a -> b -> a
const a -> b
k)

instance Mapping IxFunArrow where
  roam :: ((a -> b) -> s -> t) -> IxFunArrow i a b -> IxFunArrow i s t
roam  (a -> b) -> s -> t
f (IxFunArrow i -> a -> b
k) = (i -> s -> t) -> IxFunArrow i s t
forall i a b. (i -> a -> b) -> IxFunArrow i a b
IxFunArrow ((i -> s -> t) -> IxFunArrow i s t)
-> (i -> s -> t) -> IxFunArrow i s t
forall a b. (a -> b) -> a -> b
$ \i
i -> (a -> b) -> s -> t
f (i -> a -> b
k i
i)
  iroam :: ((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) = ((i -> j) -> s -> t) -> IxFunArrow (i -> j) s t
forall i a b. (i -> a -> b) -> IxFunArrow i a b
IxFunArrow (((i -> j) -> s -> t) -> IxFunArrow (i -> j) s t)
-> ((i -> j) -> s -> t) -> IxFunArrow (i -> j) s t
forall a b. (a -> b) -> a -> b
$ \i -> j
ij -> (i -> a -> b) -> s -> t
f ((i -> a -> b) -> s -> t) -> (i -> a -> b) -> s -> t
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 :: (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) = (a -> a) -> (b -> d) -> Exchange a b i a d
forall a b i s t. (s -> a) -> (b -> t) -> Exchange a b i s t
Exchange (b -> a
sa (b -> a) -> (a -> b) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
ss) (c -> d
tt (c -> d) -> (b -> c) -> b -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> c
bt)
  lmap :: (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) = (a -> a) -> (b -> c) -> Exchange a b i a c
forall a b i s t. (s -> a) -> (b -> t) -> Exchange a b i s t
Exchange (b -> a
sa (b -> a) -> (a -> b) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
ss) b -> c
bt
  rmap :: (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) = (b -> a) -> (b -> d) -> Exchange a b i b d
forall a b i s t. (s -> a) -> (b -> t) -> Exchange a b i s t
Exchange b -> a
sa        (c -> d
tt (c -> d) -> (b -> c) -> b -> d
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 :: (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) = (a -> a) -> (a -> b -> d) -> Store a b i a d
forall a b i s t. (s -> a) -> (s -> b -> t) -> Store a b i s t
Store (b -> a
get (b -> a) -> (a -> b) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) (\a
s -> c -> d
g (c -> d) -> (b -> c) -> b -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> b -> c
set (a -> b
f a
s))
  lmap :: (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) = (a -> a) -> (a -> b -> c) -> Store a b i a c
forall a b i s t. (s -> a) -> (s -> b -> t) -> Store a b i s t
Store (b -> a
get (b -> a) -> (a -> b) -> a -> a
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 :: (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) = (b -> a) -> (b -> b -> d) -> Store a b i b d
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 (c -> d) -> (b -> c) -> b -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> b -> c
set b
s)

instance Strong (Store a b) where
  first' :: Store a b i a b -> Store a b i (a, c) (b, c)
first' (Store a -> a
get a -> b -> b
set) = ((a, c) -> a)
-> ((a, c) -> b -> (b, c)) -> Store a b i (a, c) (b, c)
forall a b i s t. (s -> a) -> (s -> b -> t) -> Store a b i s t
Store (a -> a
get (a -> a) -> ((a, c) -> a) -> (a, c) -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, c) -> a
forall a b. (a, b) -> a
fst) (\(a
s, c
c) b
b -> (a -> b -> b
set a
s b
b, c
c))
  second' :: Store a b i a b -> Store a b i (c, a) (c, b)
second' (Store a -> a
get a -> b -> b
set) = ((c, a) -> a)
-> ((c, a) -> b -> (c, b)) -> Store a b i (c, a) (c, b)
forall a b i s t. (s -> a) -> (s -> b -> t) -> Store a b i s t
Store (a -> a
get (a -> a) -> ((c, a) -> a) -> (c, a) -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c, a) -> a
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 :: (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) = (b -> b) -> (s -> Either b a) -> Market a b i s b
forall a b i s t. (b -> t) -> (s -> Either t a) -> Market a b i s t
Market (a -> b
f (a -> b) -> (b -> a) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
bt) ((a -> Either b a) -> (a -> Either b a) -> Either a a -> Either b a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (b -> Either b a
forall a b. a -> Either a b
Left (b -> Either b a) -> (a -> b) -> a -> Either b a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) a -> Either b a
forall a b. b -> Either a b
Right (Either a a -> Either b a) -> (s -> Either a a) -> s -> Either b a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Either a a
seta)

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

instance Choice (Market a b) where
  left' :: 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) = (b -> Either b c)
-> (Either a c -> Either (Either b c) a)
-> Market a b i (Either a c) (Either b c)
forall a b i s t. (b -> t) -> (s -> Either t a) -> Market a b i s t
Market (b -> Either b c
forall a b. a -> Either a b
Left (b -> Either b c) -> (b -> b) -> b -> Either b c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> b
bt) ((Either a c -> Either (Either b c) a)
 -> Market a b i (Either a c) (Either b c))
-> (Either a c -> Either (Either b c) a)
-> Market a b i (Either a c) (Either b c)
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 -> Either b c -> Either (Either b c) a
forall a b. a -> Either a b
Left (b -> Either b c
forall a b. a -> Either a b
Left b
t)
      Right a
a -> a -> Either (Either b c) a
forall a b. b -> Either a b
Right a
a
    Right c
c -> Either b c -> Either (Either b c) a
forall a b. a -> Either a b
Left (c -> Either b c
forall a b. b -> Either a b
Right c
c)
  right' :: 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) = (b -> Either c b)
-> (Either c a -> Either (Either c b) a)
-> Market a b i (Either c a) (Either c b)
forall a b i s t. (b -> t) -> (s -> Either t a) -> Market a b i s t
Market (b -> Either c b
forall a b. b -> Either a b
Right (b -> Either c b) -> (b -> b) -> b -> Either c b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> b
bt) ((Either c a -> Either (Either c b) a)
 -> Market a b i (Either c a) (Either c b))
-> (Either c a -> Either (Either c b) a)
-> Market a b i (Either c a) (Either c b)
forall a b. (a -> b) -> a -> b
$ \Either c a
cs -> case Either c a
cs of
    Left c
c -> Either c b -> Either (Either c b) a
forall a b. a -> Either a b
Left (c -> Either c b
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 -> Either c b -> Either (Either c b) a
forall a b. a -> Either a b
Left (b -> Either c b
forall a b. b -> Either a b
Right b
t)
      Right a
a -> a -> Either (Either c b) 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 :: (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) = (a -> b -> d) -> (a -> Either d a) -> AffineMarket a b i a d
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))
    ((c -> Either d a) -> (a -> Either d a) -> Either c a -> Either d a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (d -> Either d a
forall a b. a -> Either a b
Left (d -> Either d a) -> (c -> d) -> c -> Either d a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> d
g) a -> Either d a
forall a b. b -> Either a b
Right (Either c a -> Either d a) -> (a -> Either c a) -> a -> Either d a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either c a
seta (b -> Either c a) -> (a -> b) -> a -> Either c a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  lmap :: (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) = (a -> b -> c) -> (a -> Either c a) -> AffineMarket a b i a c
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 (b -> Either c a) -> (a -> b) -> a -> Either c a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  rmap :: (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) = (b -> b -> d) -> (b -> Either d a) -> AffineMarket a b i b d
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))
    ((c -> Either d a) -> (a -> Either d a) -> Either c a -> Either d a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (d -> Either d a
forall a b. a -> Either a b
Left (d -> Either d a) -> (c -> d) -> c -> Either d a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> d
g) a -> Either d a
forall a b. b -> Either a b
Right (Either c a -> Either d a) -> (b -> Either c a) -> b -> Either d a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either c a
seta)

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

instance Strong (AffineMarket a b) where
  first' :: 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) = ((a, c) -> b -> (b, c))
-> ((a, c) -> Either (b, c) a) -> AffineMarket a b i (a, c) (b, c)
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) -> (b -> (b, c)) -> (a -> a) -> Either b a -> Either (b, c) a
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
bimap (,c
c) a -> a
forall a. a -> a
id (a -> Either b a
seta a
a))
  second' :: 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) = ((c, a) -> b -> (c, b))
-> ((c, a) -> Either (c, b) a) -> AffineMarket a b i (c, a) (c, b)
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) -> (b -> (c, b)) -> (a -> a) -> Either b a -> Either (c, b) a
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
bimap (c
c,) a -> a
forall a. a -> a
id (a -> Either b a
seta a
a))

bimap :: (a -> b) -> (c -> d) -> Either a c -> Either b d
bimap :: (a -> b) -> (c -> d) -> Either a c -> Either b d
bimap a -> b
f c -> d
g = (a -> Either b d) -> (c -> Either b d) -> Either a c -> Either b d
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (b -> Either b d
forall a b. a -> Either a b
Left (b -> Either b d) -> (a -> b) -> a -> Either b d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) (d -> Either b d
forall a b. b -> Either a b
Right (d -> Either b d) -> (c -> d) -> c -> Either b d
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 { Tagged i a b -> b
unTagged :: b }

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

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

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

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


data Context a b t = Context (b -> t) a
  deriving a -> Context a b b -> Context a b a
(a -> b) -> Context a b a -> Context a b b
(forall a b. (a -> b) -> Context a b a -> Context a b b)
-> (forall a b. a -> Context a b b -> Context a b a)
-> Functor (Context a b)
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
<$ :: 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 :: (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)
#. :: (b -> c) -> (a -> b) -> a -> c
(#.) b -> c
_f = (a -> b) -> a -> c
coerce
infixl 8 .#

-- | 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)
.# :: (b -> c) -> (a -> b) -> a -> c
(.#) b -> c
f a -> b
_g = (b -> c) -> a -> c
coerce b -> c
f
infixr 9 #.