{-# LANGUAGE CPP #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE RoleAnnotations #-}
#if __GLASGOW_HASKELL__ >= 711
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
#endif

-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Lens.Internal.Bazaar
-- Copyright   :  (C) 2012-2016 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  experimental
-- Portability :  non-portable
--
----------------------------------------------------------------------------
module Control.Lens.Internal.Bazaar
  ( Bizarre(..)
  , Bazaar(..), Bazaar'
  , BazaarT(..), BazaarT'
  , Bizarre1(..)
  , Bazaar1(..), Bazaar1'
  , BazaarT1(..), BazaarT1'
  ) where

import Prelude ()

import Control.Arrow as Arrow
import qualified Control.Category as C
import Control.Comonad
import Control.Lens.Internal.Prelude
import Control.Lens.Internal.Context
import Control.Lens.Internal.Indexed
import Data.Functor.Apply
import Data.Profunctor.Rep

------------------------------------------------------------------------------
-- Bizarre
------------------------------------------------------------------------------

-- | This class is used to run the various 'Bazaar' variants used in this
-- library.
class Profunctor p => Bizarre p w | w -> p where
  bazaar :: Applicative f => p a (f b) -> w a b t -> f t

------------------------------------------------------------------------------
-- Bazaar
------------------------------------------------------------------------------

-- | This is used to characterize a 'Control.Lens.Traversal.Traversal'.
--
-- a.k.a. indexed Cartesian store comonad, indexed Kleene store comonad, or an indexed 'FunList'.
--
-- <http://twanvl.nl/blog/haskell/non-regular1>
--
-- A 'Bazaar' is like a 'Control.Lens.Traversal.Traversal' that has already been applied to some structure.
--
-- Where a @'Context' a b t@ holds an @a@ and a function from @b@ to
-- @t@, a @'Bazaar' a b t@ holds @N@ @a@s and a function from @N@
-- @b@s to @t@, (where @N@ might be infinite).
--
-- Mnemonically, a 'Bazaar' holds many stores and you can easily add more.
--
-- This is a final encoding of 'Bazaar'.
newtype Bazaar p a b t = Bazaar { Bazaar p a b t
-> forall (f :: * -> *). Applicative f => p a (f b) -> f t
runBazaar :: forall f. Applicative f => p a (f b) -> f t }
-- type role Bazaar representatonal nominal nominal nominal

-- | This alias is helpful when it comes to reducing repetition in type signatures.
--
-- @
-- type 'Bazaar'' p a t = 'Bazaar' p a a t
-- @
type Bazaar' p a = Bazaar p a a

instance IndexedFunctor (Bazaar p) where
  ifmap :: (s -> t) -> Bazaar p a b s -> Bazaar p a b t
ifmap s -> t
f (Bazaar forall (f :: * -> *). Applicative f => p a (f b) -> f s
k) = (forall (f :: * -> *). Applicative f => p a (f b) -> f t)
-> Bazaar p a b t
forall (p :: * -> * -> *) a b t.
(forall (f :: * -> *). Applicative f => p a (f b) -> f t)
-> Bazaar p a b t
Bazaar ((s -> t) -> f s -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap s -> t
f (f s -> f t) -> (p a (f b) -> f s) -> p a (f b) -> f t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a (f b) -> f s
forall (f :: * -> *). Applicative f => p a (f b) -> f s
k)
  {-# INLINE ifmap #-}

instance Conjoined p => IndexedComonad (Bazaar p) where
  iextract :: Bazaar p a a t -> t
iextract (Bazaar forall (f :: * -> *). Applicative f => p a (f a) -> f t
m) = Identity t -> t
forall a. Identity a -> a
runIdentity (Identity t -> t) -> Identity t -> t
forall a b. (a -> b) -> a -> b
$ p a (Identity a) -> Identity t
forall (f :: * -> *). Applicative f => p a (f a) -> f t
m ((a -> Identity a) -> p a (Identity a)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr a -> Identity a
forall a. a -> Identity a
Identity)
  {-# INLINE iextract #-}
  iduplicate :: Bazaar p a c t -> Bazaar p a b (Bazaar p b c t)
iduplicate (Bazaar forall (f :: * -> *). Applicative f => p a (f c) -> f t
m) = Compose (Bazaar p a b) (Bazaar p b c) t
-> Bazaar p a b (Bazaar p b c t)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose (Compose (Bazaar p a b) (Bazaar p b c) t
 -> Bazaar p a b (Bazaar p b c t))
-> Compose (Bazaar p a b) (Bazaar p b c) t
-> Bazaar p a b (Bazaar p b c t)
forall a b. (a -> b) -> a -> b
$ p a (Compose (Bazaar p a b) (Bazaar p b c) c)
-> Compose (Bazaar p a b) (Bazaar p b c) t
forall (f :: * -> *). Applicative f => p a (f c) -> f t
m (Bazaar p a b (Bazaar p b c c)
-> Compose (Bazaar p a b) (Bazaar p b c) c
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Bazaar p a b (Bazaar p b c c)
 -> Compose (Bazaar p a b) (Bazaar p b c) c)
-> p a (Bazaar p a b (Bazaar p b c c))
-> p a (Compose (Bazaar p a b) (Bazaar p b c) c)
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. p b (Bazaar p b c c)
-> p (Bazaar p a b b) (Bazaar p a b (Bazaar p b c c))
forall (p :: * -> * -> *) (f :: * -> *) a b.
(Conjoined p, Functor f) =>
p a b -> p (f a) (f b)
distrib p b (Bazaar p b c c)
forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell p (Bazaar p a b b) (Bazaar p a b (Bazaar p b c c))
-> p a (Bazaar p a b b) -> p a (Bazaar p a b (Bazaar p b c c))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
C.. p a (Bazaar p a b b)
forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell)
  {-# INLINE iduplicate #-}

instance Corepresentable p => Sellable p (Bazaar p) where
  sell :: p a (Bazaar p a b b)
sell = (Corep p a -> Bazaar p a b b) -> p a (Bazaar p a b b)
forall (p :: * -> * -> *) d c.
Corepresentable p =>
(Corep p d -> c) -> p d c
cotabulate ((Corep p a -> Bazaar p a b b) -> p a (Bazaar p a b b))
-> (Corep p a -> Bazaar p a b b) -> p a (Bazaar p a b b)
forall a b. (a -> b) -> a -> b
$ \ Corep p a
w -> (forall (f :: * -> *). Applicative f => p a (f b) -> f b)
-> Bazaar p a b b
forall (p :: * -> * -> *) a b t.
(forall (f :: * -> *). Applicative f => p a (f b) -> f t)
-> Bazaar p a b t
Bazaar ((forall (f :: * -> *). Applicative f => p a (f b) -> f b)
 -> Bazaar p a b b)
-> (forall (f :: * -> *). Applicative f => p a (f b) -> f b)
-> Bazaar p a b b
forall a b. (a -> b) -> a -> b
$ (p a (f b) -> Rep (->) (f b)) -> p a (f b) -> f b
forall (p :: * -> * -> *) d c.
Representable p =>
(d -> Rep p c) -> p d c
tabulate ((p a (f b) -> Rep (->) (f b)) -> p a (f b) -> f b)
-> (p a (f b) -> Rep (->) (f b)) -> p a (f b) -> f b
forall a b. (a -> b) -> a -> b
$ \p a (f b)
k -> f b -> Identity (f b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (p a (f b) -> Corep p a -> f b
forall (p :: * -> * -> *) (f :: * -> *) a b.
Cosieve p f =>
p a b -> f a -> b
cosieve p a (f b)
k Corep p a
w)
  {-# INLINE sell #-}

instance Profunctor p => Bizarre p (Bazaar p) where
  bazaar :: p a (f b) -> Bazaar p a b t -> f t
bazaar p a (f b)
g (Bazaar forall (f :: * -> *). Applicative f => p a (f b) -> f t
f) = p a (f b) -> f t
forall (f :: * -> *). Applicative f => p a (f b) -> f t
f p a (f b)
g
  {-# INLINE bazaar #-}

instance Functor (Bazaar p a b) where
  fmap :: (a -> b) -> Bazaar p a b a -> Bazaar p a b b
fmap = (a -> b) -> Bazaar p a b a -> Bazaar p a b b
forall (w :: * -> * -> * -> *) s t a b.
IndexedFunctor w =>
(s -> t) -> w a b s -> w a b t
ifmap
  {-# INLINE fmap #-}
  a
x <$ :: a -> Bazaar p a b b -> Bazaar p a b a
<$ Bazaar forall (f :: * -> *). Applicative f => p a (f b) -> f b
k = (forall (f :: * -> *). Applicative f => p a (f b) -> f a)
-> Bazaar p a b a
forall (p :: * -> * -> *) a b t.
(forall (f :: * -> *). Applicative f => p a (f b) -> f t)
-> Bazaar p a b t
Bazaar ( (a
x a -> f b -> f a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$) (f b -> f a) -> (p a (f b) -> f b) -> p a (f b) -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a (f b) -> f b
forall (f :: * -> *). Applicative f => p a (f b) -> f b
k )
  {-# INLINE (<$) #-}

instance Apply (Bazaar p a b) where
  <.> :: Bazaar p a b (a -> b) -> Bazaar p a b a -> Bazaar p a b b
(<.>) = Bazaar p a b (a -> b) -> Bazaar p a b a -> Bazaar p a b b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)
  {-# INLINE (<.>) #-}
  .> :: Bazaar p a b a -> Bazaar p a b b -> Bazaar p a b b
(.>) = Bazaar p a b a -> Bazaar p a b b -> Bazaar p a b b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
  {-# INLINE (.>) #-}
  <. :: Bazaar p a b a -> Bazaar p a b b -> Bazaar p a b a
(<.) = Bazaar p a b a -> Bazaar p a b b -> Bazaar p a b a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
(<*)
  {-# INLINE (<.) #-}

instance Applicative (Bazaar p a b) where
  pure :: a -> Bazaar p a b a
pure a
a = (forall (f :: * -> *). Applicative f => p a (f b) -> f a)
-> Bazaar p a b a
forall (p :: * -> * -> *) a b t.
(forall (f :: * -> *). Applicative f => p a (f b) -> f t)
-> Bazaar p a b t
Bazaar ((forall (f :: * -> *). Applicative f => p a (f b) -> f a)
 -> Bazaar p a b a)
-> (forall (f :: * -> *). Applicative f => p a (f b) -> f a)
-> Bazaar p a b a
forall a b. (a -> b) -> a -> b
$ \p a (f b)
_ -> a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
  {-# INLINE pure #-}
  Bazaar forall (f :: * -> *). Applicative f => p a (f b) -> f (a -> b)
mf <*> :: Bazaar p a b (a -> b) -> Bazaar p a b a -> Bazaar p a b b
<*> Bazaar forall (f :: * -> *). Applicative f => p a (f b) -> f a
ma = (forall (f :: * -> *). Applicative f => p a (f b) -> f b)
-> Bazaar p a b b
forall (p :: * -> * -> *) a b t.
(forall (f :: * -> *). Applicative f => p a (f b) -> f t)
-> Bazaar p a b t
Bazaar ((forall (f :: * -> *). Applicative f => p a (f b) -> f b)
 -> Bazaar p a b b)
-> (forall (f :: * -> *). Applicative f => p a (f b) -> f b)
-> Bazaar p a b b
forall a b. (a -> b) -> a -> b
$ \ p a (f b)
pafb -> p a (f b) -> f (a -> b)
forall (f :: * -> *). Applicative f => p a (f b) -> f (a -> b)
mf p a (f b)
pafb f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> p a (f b) -> f a
forall (f :: * -> *). Applicative f => p a (f b) -> f a
ma p a (f b)
pafb
  {-# INLINE (<*>) #-}
#if MIN_VERSION_base(4,10,0)
  liftA2 :: (a -> b -> c) -> Bazaar p a b a -> Bazaar p a b b -> Bazaar p a b c
liftA2 a -> b -> c
f (Bazaar forall (f :: * -> *). Applicative f => p a (f b) -> f a
mx) (Bazaar forall (f :: * -> *). Applicative f => p a (f b) -> f b
my) = (forall (f :: * -> *). Applicative f => p a (f b) -> f c)
-> Bazaar p a b c
forall (p :: * -> * -> *) a b t.
(forall (f :: * -> *). Applicative f => p a (f b) -> f t)
-> Bazaar p a b t
Bazaar ((forall (f :: * -> *). Applicative f => p a (f b) -> f c)
 -> Bazaar p a b c)
-> (forall (f :: * -> *). Applicative f => p a (f b) -> f c)
-> Bazaar p a b c
forall a b. (a -> b) -> a -> b
$ \p a (f b)
pafb -> (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> c
f (p a (f b) -> f a
forall (f :: * -> *). Applicative f => p a (f b) -> f a
mx p a (f b)
pafb) (p a (f b) -> f b
forall (f :: * -> *). Applicative f => p a (f b) -> f b
my p a (f b)
pafb)
  {-# INLINE liftA2 #-}
#endif
  Bazaar forall (f :: * -> *). Applicative f => p a (f b) -> f a
mx *> :: Bazaar p a b a -> Bazaar p a b b -> Bazaar p a b b
*> Bazaar forall (f :: * -> *). Applicative f => p a (f b) -> f b
my = (forall (f :: * -> *). Applicative f => p a (f b) -> f b)
-> Bazaar p a b b
forall (p :: * -> * -> *) a b t.
(forall (f :: * -> *). Applicative f => p a (f b) -> f t)
-> Bazaar p a b t
Bazaar ((forall (f :: * -> *). Applicative f => p a (f b) -> f b)
 -> Bazaar p a b b)
-> (forall (f :: * -> *). Applicative f => p a (f b) -> f b)
-> Bazaar p a b b
forall a b. (a -> b) -> a -> b
$ \p a (f b)
pafb -> p a (f b) -> f a
forall (f :: * -> *). Applicative f => p a (f b) -> f a
mx p a (f b)
pafb f a -> f b -> f b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> p a (f b) -> f b
forall (f :: * -> *). Applicative f => p a (f b) -> f b
my p a (f b)
pafb
  {-# INLINE (*>) #-}
  Bazaar forall (f :: * -> *). Applicative f => p a (f b) -> f a
mx <* :: Bazaar p a b a -> Bazaar p a b b -> Bazaar p a b a
<* Bazaar forall (f :: * -> *). Applicative f => p a (f b) -> f b
my = (forall (f :: * -> *). Applicative f => p a (f b) -> f a)
-> Bazaar p a b a
forall (p :: * -> * -> *) a b t.
(forall (f :: * -> *). Applicative f => p a (f b) -> f t)
-> Bazaar p a b t
Bazaar ((forall (f :: * -> *). Applicative f => p a (f b) -> f a)
 -> Bazaar p a b a)
-> (forall (f :: * -> *). Applicative f => p a (f b) -> f a)
-> Bazaar p a b a
forall a b. (a -> b) -> a -> b
$ \p a (f b)
pafb -> p a (f b) -> f a
forall (f :: * -> *). Applicative f => p a (f b) -> f a
mx p a (f b)
pafb f a -> f b -> f a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* p a (f b) -> f b
forall (f :: * -> *). Applicative f => p a (f b) -> f b
my p a (f b)
pafb
  {-# INLINE (<*) #-}

instance (a ~ b, Conjoined p) => Comonad (Bazaar p a b) where
  extract :: Bazaar p a b a -> a
extract = Bazaar p a b a -> a
forall (w :: * -> * -> * -> *) a t.
IndexedComonad w =>
w a a t -> t
iextract
  {-# INLINE extract #-}
  duplicate :: Bazaar p a b a -> Bazaar p a b (Bazaar p a b a)
duplicate = Bazaar p a b a -> Bazaar p a b (Bazaar p a b a)
forall (w :: * -> * -> * -> *) a c t b.
IndexedComonad w =>
w a c t -> w a b (w b c t)
iduplicate
  {-# INLINE duplicate #-}

instance (a ~ b, Conjoined p) => ComonadApply (Bazaar p a b) where
  <@> :: Bazaar p a b (a -> b) -> Bazaar p a b a -> Bazaar p a b b
(<@>) = Bazaar p a b (a -> b) -> Bazaar p a b a -> Bazaar p a b b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)
  {-# INLINE (<@>) #-}
  @> :: Bazaar p a b a -> Bazaar p a b b -> Bazaar p a b b
(@>) = Bazaar p a b a -> Bazaar p a b b -> Bazaar p a b b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
  {-# INLINE (@>) #-}
  <@ :: Bazaar p a b a -> Bazaar p a b b -> Bazaar p a b a
(<@) = Bazaar p a b a -> Bazaar p a b b -> Bazaar p a b a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
(<*)
  {-# INLINE (<@) #-}

------------------------------------------------------------------------------
-- BazaarT
------------------------------------------------------------------------------

-- | 'BazaarT' is like 'Bazaar', except that it provides a questionable 'Contravariant' instance
-- To protect this instance it relies on the soundness of another 'Contravariant' type, and usage conventions.
--
-- For example. This lets us write a suitably polymorphic and lazy 'Control.Lens.Traversal.taking', but there
-- must be a better way!
newtype BazaarT p (g :: * -> *) a b t = BazaarT { BazaarT p g a b t
-> forall (f :: * -> *). Applicative f => p a (f b) -> f t
runBazaarT :: forall f. Applicative f => p a (f b) -> f t }
type role BazaarT representational nominal nominal nominal nominal

-- | This alias is helpful when it comes to reducing repetition in type signatures.
--
-- @
-- type 'BazaarT'' p g a t = 'BazaarT' p g a a t
-- @
type BazaarT' p g a = BazaarT p g a a

instance IndexedFunctor (BazaarT p g) where
  ifmap :: (s -> t) -> BazaarT p g a b s -> BazaarT p g a b t
ifmap s -> t
f (BazaarT forall (f :: * -> *). Applicative f => p a (f b) -> f s
k) = (forall (f :: * -> *). Applicative f => p a (f b) -> f t)
-> BazaarT p g a b t
forall (p :: * -> * -> *) (g :: * -> *) a b t.
(forall (f :: * -> *). Applicative f => p a (f b) -> f t)
-> BazaarT p g a b t
BazaarT ((s -> t) -> f s -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap s -> t
f (f s -> f t) -> (p a (f b) -> f s) -> p a (f b) -> f t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a (f b) -> f s
forall (f :: * -> *). Applicative f => p a (f b) -> f s
k)
  {-# INLINE ifmap #-}

instance Conjoined p => IndexedComonad (BazaarT p g) where
  iextract :: BazaarT p g a a t -> t
iextract (BazaarT forall (f :: * -> *). Applicative f => p a (f a) -> f t
m) = Identity t -> t
forall a. Identity a -> a
runIdentity (Identity t -> t) -> Identity t -> t
forall a b. (a -> b) -> a -> b
$ p a (Identity a) -> Identity t
forall (f :: * -> *). Applicative f => p a (f a) -> f t
m ((a -> Identity a) -> p a (Identity a)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr a -> Identity a
forall a. a -> Identity a
Identity)
  {-# INLINE iextract #-}
  iduplicate :: BazaarT p g a c t -> BazaarT p g a b (BazaarT p g b c t)
iduplicate (BazaarT forall (f :: * -> *). Applicative f => p a (f c) -> f t
m) = Compose (BazaarT p g a b) (BazaarT p g b c) t
-> BazaarT p g a b (BazaarT p g b c t)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose (Compose (BazaarT p g a b) (BazaarT p g b c) t
 -> BazaarT p g a b (BazaarT p g b c t))
-> Compose (BazaarT p g a b) (BazaarT p g b c) t
-> BazaarT p g a b (BazaarT p g b c t)
forall a b. (a -> b) -> a -> b
$ p a (Compose (BazaarT p g a b) (BazaarT p g b c) c)
-> Compose (BazaarT p g a b) (BazaarT p g b c) t
forall (f :: * -> *). Applicative f => p a (f c) -> f t
m (BazaarT p g a b (BazaarT p g b c c)
-> Compose (BazaarT p g a b) (BazaarT p g b c) c
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (BazaarT p g a b (BazaarT p g b c c)
 -> Compose (BazaarT p g a b) (BazaarT p g b c) c)
-> p a (BazaarT p g a b (BazaarT p g b c c))
-> p a (Compose (BazaarT p g a b) (BazaarT p g b c) c)
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. p b (BazaarT p g b c c)
-> p (BazaarT p g a b b) (BazaarT p g a b (BazaarT p g b c c))
forall (p :: * -> * -> *) (f :: * -> *) a b.
(Conjoined p, Functor f) =>
p a b -> p (f a) (f b)
distrib p b (BazaarT p g b c c)
forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell p (BazaarT p g a b b) (BazaarT p g a b (BazaarT p g b c c))
-> p a (BazaarT p g a b b)
-> p a (BazaarT p g a b (BazaarT p g b c c))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
C.. p a (BazaarT p g a b b)
forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell)
  {-# INLINE iduplicate #-}

instance Corepresentable p => Sellable p (BazaarT p g) where
  sell :: p a (BazaarT p g a b b)
sell = (Corep p a -> BazaarT p g a b b) -> p a (BazaarT p g a b b)
forall (p :: * -> * -> *) d c.
Corepresentable p =>
(Corep p d -> c) -> p d c
cotabulate ((Corep p a -> BazaarT p g a b b) -> p a (BazaarT p g a b b))
-> (Corep p a -> BazaarT p g a b b) -> p a (BazaarT p g a b b)
forall a b. (a -> b) -> a -> b
$ \ Corep p a
w -> (forall (f :: * -> *). Applicative f => p a (f b) -> f b)
-> BazaarT p g a b b
forall (p :: * -> * -> *) (g :: * -> *) a b t.
(forall (f :: * -> *). Applicative f => p a (f b) -> f t)
-> BazaarT p g a b t
BazaarT (p a (f b) -> Corep p a -> f b
forall (p :: * -> * -> *) (f :: * -> *) a b.
Cosieve p f =>
p a b -> f a -> b
`cosieve` Corep p a
w)
  {-# INLINE sell #-}

instance Profunctor p => Bizarre p (BazaarT p g) where
  bazaar :: p a (f b) -> BazaarT p g a b t -> f t
bazaar p a (f b)
g (BazaarT forall (f :: * -> *). Applicative f => p a (f b) -> f t
f) = p a (f b) -> f t
forall (f :: * -> *). Applicative f => p a (f b) -> f t
f p a (f b)
g
  {-# INLINE bazaar #-}

instance Functor (BazaarT p g a b) where
  fmap :: (a -> b) -> BazaarT p g a b a -> BazaarT p g a b b
fmap = (a -> b) -> BazaarT p g a b a -> BazaarT p g a b b
forall (w :: * -> * -> * -> *) s t a b.
IndexedFunctor w =>
(s -> t) -> w a b s -> w a b t
ifmap
  {-# INLINE fmap #-}
  a
x <$ :: a -> BazaarT p g a b b -> BazaarT p g a b a
<$ BazaarT forall (f :: * -> *). Applicative f => p a (f b) -> f b
k = (forall (f :: * -> *). Applicative f => p a (f b) -> f a)
-> BazaarT p g a b a
forall (p :: * -> * -> *) (g :: * -> *) a b t.
(forall (f :: * -> *). Applicative f => p a (f b) -> f t)
-> BazaarT p g a b t
BazaarT ( (a
x a -> f b -> f a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$) (f b -> f a) -> (p a (f b) -> f b) -> p a (f b) -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a (f b) -> f b
forall (f :: * -> *). Applicative f => p a (f b) -> f b
k )
  {-# INLINE (<$) #-}

instance Apply (BazaarT p g a b) where
  <.> :: BazaarT p g a b (a -> b) -> BazaarT p g a b a -> BazaarT p g a b b
(<.>) = BazaarT p g a b (a -> b) -> BazaarT p g a b a -> BazaarT p g a b b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)
  {-# INLINE (<.>) #-}
  .> :: BazaarT p g a b a -> BazaarT p g a b b -> BazaarT p g a b b
(.>) = BazaarT p g a b a -> BazaarT p g a b b -> BazaarT p g a b b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
  {-# INLINE (.>) #-}
  <. :: BazaarT p g a b a -> BazaarT p g a b b -> BazaarT p g a b a
(<.) = BazaarT p g a b a -> BazaarT p g a b b -> BazaarT p g a b a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
(<*)
  {-# INLINE (<.) #-}

instance Applicative (BazaarT p g a b) where
  pure :: a -> BazaarT p g a b a
pure a
a = (forall (f :: * -> *). Applicative f => p a (f b) -> f a)
-> BazaarT p g a b a
forall (p :: * -> * -> *) (g :: * -> *) a b t.
(forall (f :: * -> *). Applicative f => p a (f b) -> f t)
-> BazaarT p g a b t
BazaarT ((forall (f :: * -> *). Applicative f => p a (f b) -> f a)
 -> BazaarT p g a b a)
-> (forall (f :: * -> *). Applicative f => p a (f b) -> f a)
-> BazaarT p g a b a
forall a b. (a -> b) -> a -> b
$ (p a (f b) -> Rep (->) (f a)) -> p a (f b) -> f a
forall (p :: * -> * -> *) d c.
Representable p =>
(d -> Rep p c) -> p d c
tabulate ((p a (f b) -> Rep (->) (f a)) -> p a (f b) -> f a)
-> (p a (f b) -> Rep (->) (f a)) -> p a (f b) -> f a
forall a b. (a -> b) -> a -> b
$ \p a (f b)
_ -> f a -> Identity (f a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a)
  {-# INLINE pure #-}
  BazaarT forall (f :: * -> *). Applicative f => p a (f b) -> f (a -> b)
mf <*> :: BazaarT p g a b (a -> b) -> BazaarT p g a b a -> BazaarT p g a b b
<*> BazaarT forall (f :: * -> *). Applicative f => p a (f b) -> f a
ma = (forall (f :: * -> *). Applicative f => p a (f b) -> f b)
-> BazaarT p g a b b
forall (p :: * -> * -> *) (g :: * -> *) a b t.
(forall (f :: * -> *). Applicative f => p a (f b) -> f t)
-> BazaarT p g a b t
BazaarT ((forall (f :: * -> *). Applicative f => p a (f b) -> f b)
 -> BazaarT p g a b b)
-> (forall (f :: * -> *). Applicative f => p a (f b) -> f b)
-> BazaarT p g a b b
forall a b. (a -> b) -> a -> b
$ \ p a (f b)
pafb -> p a (f b) -> f (a -> b)
forall (f :: * -> *). Applicative f => p a (f b) -> f (a -> b)
mf p a (f b)
pafb f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> p a (f b) -> f a
forall (f :: * -> *). Applicative f => p a (f b) -> f a
ma p a (f b)
pafb
  {-# INLINE (<*>) #-}
#if MIN_VERSION_base(4,10,0)
  liftA2 :: (a -> b -> c)
-> BazaarT p g a b a -> BazaarT p g a b b -> BazaarT p g a b c
liftA2 a -> b -> c
f (BazaarT forall (f :: * -> *). Applicative f => p a (f b) -> f a
mx) (BazaarT forall (f :: * -> *). Applicative f => p a (f b) -> f b
my) = (forall (f :: * -> *). Applicative f => p a (f b) -> f c)
-> BazaarT p g a b c
forall (p :: * -> * -> *) (g :: * -> *) a b t.
(forall (f :: * -> *). Applicative f => p a (f b) -> f t)
-> BazaarT p g a b t
BazaarT ((forall (f :: * -> *). Applicative f => p a (f b) -> f c)
 -> BazaarT p g a b c)
-> (forall (f :: * -> *). Applicative f => p a (f b) -> f c)
-> BazaarT p g a b c
forall a b. (a -> b) -> a -> b
$ \p a (f b)
pafb -> (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> c
f (p a (f b) -> f a
forall (f :: * -> *). Applicative f => p a (f b) -> f a
mx p a (f b)
pafb) (p a (f b) -> f b
forall (f :: * -> *). Applicative f => p a (f b) -> f b
my p a (f b)
pafb)
  {-# INLINE liftA2 #-}
#endif
  BazaarT forall (f :: * -> *). Applicative f => p a (f b) -> f a
mf *> :: BazaarT p g a b a -> BazaarT p g a b b -> BazaarT p g a b b
*> BazaarT forall (f :: * -> *). Applicative f => p a (f b) -> f b
ma = (forall (f :: * -> *). Applicative f => p a (f b) -> f b)
-> BazaarT p g a b b
forall (p :: * -> * -> *) (g :: * -> *) a b t.
(forall (f :: * -> *). Applicative f => p a (f b) -> f t)
-> BazaarT p g a b t
BazaarT ((forall (f :: * -> *). Applicative f => p a (f b) -> f b)
 -> BazaarT p g a b b)
-> (forall (f :: * -> *). Applicative f => p a (f b) -> f b)
-> BazaarT p g a b b
forall a b. (a -> b) -> a -> b
$ \ p a (f b)
pafb -> p a (f b) -> f a
forall (f :: * -> *). Applicative f => p a (f b) -> f a
mf p a (f b)
pafb f a -> f b -> f b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> p a (f b) -> f b
forall (f :: * -> *). Applicative f => p a (f b) -> f b
ma p a (f b)
pafb
  {-# INLINE (*>) #-}
  BazaarT forall (f :: * -> *). Applicative f => p a (f b) -> f a
mf <* :: BazaarT p g a b a -> BazaarT p g a b b -> BazaarT p g a b a
<* BazaarT forall (f :: * -> *). Applicative f => p a (f b) -> f b
ma = (forall (f :: * -> *). Applicative f => p a (f b) -> f a)
-> BazaarT p g a b a
forall (p :: * -> * -> *) (g :: * -> *) a b t.
(forall (f :: * -> *). Applicative f => p a (f b) -> f t)
-> BazaarT p g a b t
BazaarT ((forall (f :: * -> *). Applicative f => p a (f b) -> f a)
 -> BazaarT p g a b a)
-> (forall (f :: * -> *). Applicative f => p a (f b) -> f a)
-> BazaarT p g a b a
forall a b. (a -> b) -> a -> b
$ \ p a (f b)
pafb -> p a (f b) -> f a
forall (f :: * -> *). Applicative f => p a (f b) -> f a
mf p a (f b)
pafb f a -> f b -> f a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* p a (f b) -> f b
forall (f :: * -> *). Applicative f => p a (f b) -> f b
ma p a (f b)
pafb
  {-# INLINE (<*) #-}

instance (a ~ b, Conjoined p) => Comonad (BazaarT p g a b) where
  extract :: BazaarT p g a b a -> a
extract = BazaarT p g a b a -> a
forall (w :: * -> * -> * -> *) a t.
IndexedComonad w =>
w a a t -> t
iextract
  {-# INLINE extract #-}
  duplicate :: BazaarT p g a b a -> BazaarT p g a b (BazaarT p g a b a)
duplicate = BazaarT p g a b a -> BazaarT p g a b (BazaarT p g a b a)
forall (w :: * -> * -> * -> *) a c t b.
IndexedComonad w =>
w a c t -> w a b (w b c t)
iduplicate
  {-# INLINE duplicate #-}

instance (a ~ b, Conjoined p) => ComonadApply (BazaarT p g a b) where
  <@> :: BazaarT p g a b (a -> b) -> BazaarT p g a b a -> BazaarT p g a b b
(<@>) = BazaarT p g a b (a -> b) -> BazaarT p g a b a -> BazaarT p g a b b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)
  {-# INLINE (<@>) #-}
  @> :: BazaarT p g a b a -> BazaarT p g a b b -> BazaarT p g a b b
(@>) = BazaarT p g a b a -> BazaarT p g a b b -> BazaarT p g a b b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
  {-# INLINE (@>) #-}
  <@ :: BazaarT p g a b a -> BazaarT p g a b b -> BazaarT p g a b a
(<@) = BazaarT p g a b a -> BazaarT p g a b b -> BazaarT p g a b a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
(<*)
  {-# INLINE (<@) #-}

instance (Profunctor p, Contravariant g) => Contravariant (BazaarT p g a b) where
  contramap :: (a -> b) -> BazaarT p g a b b -> BazaarT p g a b a
contramap a -> b
_ = a -> BazaarT p g a b b -> BazaarT p g a b a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
(<$) ([Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"contramap: BazaarT")
  {-# INLINE contramap #-}

instance Contravariant g => Semigroup (BazaarT p g a b t) where
  BazaarT forall (f :: * -> *). Applicative f => p a (f b) -> f t
a <> :: BazaarT p g a b t -> BazaarT p g a b t -> BazaarT p g a b t
<> BazaarT forall (f :: * -> *). Applicative f => p a (f b) -> f t
b = (forall (f :: * -> *). Applicative f => p a (f b) -> f t)
-> BazaarT p g a b t
forall (p :: * -> * -> *) (g :: * -> *) a b t.
(forall (f :: * -> *). Applicative f => p a (f b) -> f t)
-> BazaarT p g a b t
BazaarT ((forall (f :: * -> *). Applicative f => p a (f b) -> f t)
 -> BazaarT p g a b t)
-> (forall (f :: * -> *). Applicative f => p a (f b) -> f t)
-> BazaarT p g a b t
forall a b. (a -> b) -> a -> b
$ \p a (f b)
f -> p a (f b) -> f t
forall (f :: * -> *). Applicative f => p a (f b) -> f t
a p a (f b)
f f t -> f t -> f t
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* p a (f b) -> f t
forall (f :: * -> *). Applicative f => p a (f b) -> f t
b p a (f b)
f
  {-# INLINE (<>) #-}

instance Contravariant g => Monoid (BazaarT p g a b t) where
  mempty :: BazaarT p g a b t
mempty = (forall (f :: * -> *). Applicative f => p a (f b) -> f t)
-> BazaarT p g a b t
forall (p :: * -> * -> *) (g :: * -> *) a b t.
(forall (f :: * -> *). Applicative f => p a (f b) -> f t)
-> BazaarT p g a b t
BazaarT ((forall (f :: * -> *). Applicative f => p a (f b) -> f t)
 -> BazaarT p g a b t)
-> (forall (f :: * -> *). Applicative f => p a (f b) -> f t)
-> BazaarT p g a b t
forall a b. (a -> b) -> a -> b
$ \p a (f b)
_ -> t -> f t
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> t
forall a. HasCallStack => [Char] -> a
error [Char]
"mempty: BazaarT")
  {-# INLINE mempty #-}
  BazaarT forall (f :: * -> *). Applicative f => p a (f b) -> f t
a mappend :: BazaarT p g a b t -> BazaarT p g a b t -> BazaarT p g a b t
`mappend` BazaarT forall (f :: * -> *). Applicative f => p a (f b) -> f t
b = (forall (f :: * -> *). Applicative f => p a (f b) -> f t)
-> BazaarT p g a b t
forall (p :: * -> * -> *) (g :: * -> *) a b t.
(forall (f :: * -> *). Applicative f => p a (f b) -> f t)
-> BazaarT p g a b t
BazaarT ((forall (f :: * -> *). Applicative f => p a (f b) -> f t)
 -> BazaarT p g a b t)
-> (forall (f :: * -> *). Applicative f => p a (f b) -> f t)
-> BazaarT p g a b t
forall a b. (a -> b) -> a -> b
$ \p a (f b)
f -> p a (f b) -> f t
forall (f :: * -> *). Applicative f => p a (f b) -> f t
a p a (f b)
f f t -> f t -> f t
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* p a (f b) -> f t
forall (f :: * -> *). Applicative f => p a (f b) -> f t
b p a (f b)
f
  {-# INLINE mappend #-}


------------------------------------------------------------------------------
-- Bizarre1
------------------------------------------------------------------------------

class Profunctor p => Bizarre1 p w | w -> p where
  bazaar1 :: Apply f => p a (f b) -> w a b t -> f t

------------------------------------------------------------------------------
-- Bazaar1
------------------------------------------------------------------------------

-- | This is used to characterize a 'Control.Lens.Traversal.Traversal'.
--
-- a.k.a. indexed Cartesian store comonad, indexed Kleene store comonad, or an indexed 'FunList'.
--
-- <http://twanvl.nl/blog/haskell/non-regular1>
--
-- A 'Bazaar1' is like a 'Control.Lens.Traversal.Traversal' that has already been applied to some structure.
--
-- Where a @'Context' a b t@ holds an @a@ and a function from @b@ to
-- @t@, a @'Bazaar1' a b t@ holds @N@ @a@s and a function from @N@
-- @b@s to @t@, (where @N@ might be infinite).
--
-- Mnemonically, a 'Bazaar1' holds many stores and you can easily add more.
--
-- This is a final encoding of 'Bazaar1'.
newtype Bazaar1 p a b t = Bazaar1 { Bazaar1 p a b t
-> forall (f :: * -> *). Apply f => p a (f b) -> f t
runBazaar1 :: forall f. Apply f => p a (f b) -> f t }
-- type role Bazaar1 representatonal nominal nominal nominal

-- | This alias is helpful when it comes to reducing repetition in type signatures.
--
-- @
-- type 'Bazaar1'' p a t = 'Bazaar1' p a a t
-- @
type Bazaar1' p a = Bazaar1 p a a

instance IndexedFunctor (Bazaar1 p) where
  ifmap :: (s -> t) -> Bazaar1 p a b s -> Bazaar1 p a b t
ifmap s -> t
f (Bazaar1 forall (f :: * -> *). Apply f => p a (f b) -> f s
k) = (forall (f :: * -> *). Apply f => p a (f b) -> f t)
-> Bazaar1 p a b t
forall (p :: * -> * -> *) a b t.
(forall (f :: * -> *). Apply f => p a (f b) -> f t)
-> Bazaar1 p a b t
Bazaar1 ((s -> t) -> f s -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap s -> t
f (f s -> f t) -> (p a (f b) -> f s) -> p a (f b) -> f t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a (f b) -> f s
forall (f :: * -> *). Apply f => p a (f b) -> f s
k)
  {-# INLINE ifmap #-}

instance Conjoined p => IndexedComonad (Bazaar1 p) where
  iextract :: Bazaar1 p a a t -> t
iextract (Bazaar1 forall (f :: * -> *). Apply f => p a (f a) -> f t
m) = Identity t -> t
forall a. Identity a -> a
runIdentity (Identity t -> t) -> Identity t -> t
forall a b. (a -> b) -> a -> b
$ p a (Identity a) -> Identity t
forall (f :: * -> *). Apply f => p a (f a) -> f t
m ((a -> Identity a) -> p a (Identity a)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr a -> Identity a
forall a. a -> Identity a
Identity)
  {-# INLINE iextract #-}
  iduplicate :: Bazaar1 p a c t -> Bazaar1 p a b (Bazaar1 p b c t)
iduplicate (Bazaar1 forall (f :: * -> *). Apply f => p a (f c) -> f t
m) = Compose (Bazaar1 p a b) (Bazaar1 p b c) t
-> Bazaar1 p a b (Bazaar1 p b c t)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose (Compose (Bazaar1 p a b) (Bazaar1 p b c) t
 -> Bazaar1 p a b (Bazaar1 p b c t))
-> Compose (Bazaar1 p a b) (Bazaar1 p b c) t
-> Bazaar1 p a b (Bazaar1 p b c t)
forall a b. (a -> b) -> a -> b
$ p a (Compose (Bazaar1 p a b) (Bazaar1 p b c) c)
-> Compose (Bazaar1 p a b) (Bazaar1 p b c) t
forall (f :: * -> *). Apply f => p a (f c) -> f t
m (Bazaar1 p a b (Bazaar1 p b c c)
-> Compose (Bazaar1 p a b) (Bazaar1 p b c) c
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Bazaar1 p a b (Bazaar1 p b c c)
 -> Compose (Bazaar1 p a b) (Bazaar1 p b c) c)
-> p a (Bazaar1 p a b (Bazaar1 p b c c))
-> p a (Compose (Bazaar1 p a b) (Bazaar1 p b c) c)
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. p b (Bazaar1 p b c c)
-> p (Bazaar1 p a b b) (Bazaar1 p a b (Bazaar1 p b c c))
forall (p :: * -> * -> *) (f :: * -> *) a b.
(Conjoined p, Functor f) =>
p a b -> p (f a) (f b)
distrib p b (Bazaar1 p b c c)
forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell p (Bazaar1 p a b b) (Bazaar1 p a b (Bazaar1 p b c c))
-> p a (Bazaar1 p a b b) -> p a (Bazaar1 p a b (Bazaar1 p b c c))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
C.. p a (Bazaar1 p a b b)
forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell)
  {-# INLINE iduplicate #-}

instance Corepresentable p => Sellable p (Bazaar1 p) where
  sell :: p a (Bazaar1 p a b b)
sell = (Corep p a -> Bazaar1 p a b b) -> p a (Bazaar1 p a b b)
forall (p :: * -> * -> *) d c.
Corepresentable p =>
(Corep p d -> c) -> p d c
cotabulate ((Corep p a -> Bazaar1 p a b b) -> p a (Bazaar1 p a b b))
-> (Corep p a -> Bazaar1 p a b b) -> p a (Bazaar1 p a b b)
forall a b. (a -> b) -> a -> b
$ \ Corep p a
w -> (forall (f :: * -> *). Apply f => p a (f b) -> f b)
-> Bazaar1 p a b b
forall (p :: * -> * -> *) a b t.
(forall (f :: * -> *). Apply f => p a (f b) -> f t)
-> Bazaar1 p a b t
Bazaar1 ((forall (f :: * -> *). Apply f => p a (f b) -> f b)
 -> Bazaar1 p a b b)
-> (forall (f :: * -> *). Apply f => p a (f b) -> f b)
-> Bazaar1 p a b b
forall a b. (a -> b) -> a -> b
$ (p a (f b) -> Rep (->) (f b)) -> p a (f b) -> f b
forall (p :: * -> * -> *) d c.
Representable p =>
(d -> Rep p c) -> p d c
tabulate ((p a (f b) -> Rep (->) (f b)) -> p a (f b) -> f b)
-> (p a (f b) -> Rep (->) (f b)) -> p a (f b) -> f b
forall a b. (a -> b) -> a -> b
$ \p a (f b)
k -> f b -> Identity (f b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (p a (f b) -> Corep p a -> f b
forall (p :: * -> * -> *) (f :: * -> *) a b.
Cosieve p f =>
p a b -> f a -> b
cosieve p a (f b)
k Corep p a
w)
  {-# INLINE sell #-}

instance Profunctor p => Bizarre1 p (Bazaar1 p) where
  bazaar1 :: p a (f b) -> Bazaar1 p a b t -> f t
bazaar1 p a (f b)
g (Bazaar1 forall (f :: * -> *). Apply f => p a (f b) -> f t
f) = p a (f b) -> f t
forall (f :: * -> *). Apply f => p a (f b) -> f t
f p a (f b)
g
  {-# INLINE bazaar1 #-}

instance Functor (Bazaar1 p a b) where
  fmap :: (a -> b) -> Bazaar1 p a b a -> Bazaar1 p a b b
fmap = (a -> b) -> Bazaar1 p a b a -> Bazaar1 p a b b
forall (w :: * -> * -> * -> *) s t a b.
IndexedFunctor w =>
(s -> t) -> w a b s -> w a b t
ifmap
  {-# INLINE fmap #-}
  a
x <$ :: a -> Bazaar1 p a b b -> Bazaar1 p a b a
<$ Bazaar1 forall (f :: * -> *). Apply f => p a (f b) -> f b
k = (forall (f :: * -> *). Apply f => p a (f b) -> f a)
-> Bazaar1 p a b a
forall (p :: * -> * -> *) a b t.
(forall (f :: * -> *). Apply f => p a (f b) -> f t)
-> Bazaar1 p a b t
Bazaar1 ((a
x a -> f b -> f a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$) (f b -> f a) -> (p a (f b) -> f b) -> p a (f b) -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a (f b) -> f b
forall (f :: * -> *). Apply f => p a (f b) -> f b
k)
  {-# INLINE (<$) #-}

instance Apply (Bazaar1 p a b) where
  Bazaar1 forall (f :: * -> *). Apply f => p a (f b) -> f (a -> b)
mf <.> :: Bazaar1 p a b (a -> b) -> Bazaar1 p a b a -> Bazaar1 p a b b
<.> Bazaar1 forall (f :: * -> *). Apply f => p a (f b) -> f a
ma = (forall (f :: * -> *). Apply f => p a (f b) -> f b)
-> Bazaar1 p a b b
forall (p :: * -> * -> *) a b t.
(forall (f :: * -> *). Apply f => p a (f b) -> f t)
-> Bazaar1 p a b t
Bazaar1 ((forall (f :: * -> *). Apply f => p a (f b) -> f b)
 -> Bazaar1 p a b b)
-> (forall (f :: * -> *). Apply f => p a (f b) -> f b)
-> Bazaar1 p a b b
forall a b. (a -> b) -> a -> b
$ \ p a (f b)
pafb -> p a (f b) -> f (a -> b)
forall (f :: * -> *). Apply f => p a (f b) -> f (a -> b)
mf p a (f b)
pafb f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> p a (f b) -> f a
forall (f :: * -> *). Apply f => p a (f b) -> f a
ma p a (f b)
pafb
  {-# INLINE (<.>) #-}
  Bazaar1 forall (f :: * -> *). Apply f => p a (f b) -> f a
mf .> :: Bazaar1 p a b a -> Bazaar1 p a b b -> Bazaar1 p a b b
.> Bazaar1 forall (f :: * -> *). Apply f => p a (f b) -> f b
ma = (forall (f :: * -> *). Apply f => p a (f b) -> f b)
-> Bazaar1 p a b b
forall (p :: * -> * -> *) a b t.
(forall (f :: * -> *). Apply f => p a (f b) -> f t)
-> Bazaar1 p a b t
Bazaar1 ((forall (f :: * -> *). Apply f => p a (f b) -> f b)
 -> Bazaar1 p a b b)
-> (forall (f :: * -> *). Apply f => p a (f b) -> f b)
-> Bazaar1 p a b b
forall a b. (a -> b) -> a -> b
$ \ p a (f b)
pafb -> p a (f b) -> f a
forall (f :: * -> *). Apply f => p a (f b) -> f a
mf p a (f b)
pafb f a -> f b -> f b
forall (f :: * -> *) a b. Apply f => f a -> f b -> f b
.> p a (f b) -> f b
forall (f :: * -> *). Apply f => p a (f b) -> f b
ma p a (f b)
pafb
  {-# INLINE (.>) #-}
  Bazaar1 forall (f :: * -> *). Apply f => p a (f b) -> f a
mf <. :: Bazaar1 p a b a -> Bazaar1 p a b b -> Bazaar1 p a b a
<. Bazaar1 forall (f :: * -> *). Apply f => p a (f b) -> f b
ma = (forall (f :: * -> *). Apply f => p a (f b) -> f a)
-> Bazaar1 p a b a
forall (p :: * -> * -> *) a b t.
(forall (f :: * -> *). Apply f => p a (f b) -> f t)
-> Bazaar1 p a b t
Bazaar1 ((forall (f :: * -> *). Apply f => p a (f b) -> f a)
 -> Bazaar1 p a b a)
-> (forall (f :: * -> *). Apply f => p a (f b) -> f a)
-> Bazaar1 p a b a
forall a b. (a -> b) -> a -> b
$ \ p a (f b)
pafb -> p a (f b) -> f a
forall (f :: * -> *). Apply f => p a (f b) -> f a
mf p a (f b)
pafb f a -> f b -> f a
forall (f :: * -> *) a b. Apply f => f a -> f b -> f a
<. p a (f b) -> f b
forall (f :: * -> *). Apply f => p a (f b) -> f b
ma p a (f b)
pafb
  {-# INLINE (<.) #-}

instance (a ~ b, Conjoined p) => Comonad (Bazaar1 p a b) where
  extract :: Bazaar1 p a b a -> a
extract = Bazaar1 p a b a -> a
forall (w :: * -> * -> * -> *) a t.
IndexedComonad w =>
w a a t -> t
iextract
  {-# INLINE extract #-}
  duplicate :: Bazaar1 p a b a -> Bazaar1 p a b (Bazaar1 p a b a)
duplicate = Bazaar1 p a b a -> Bazaar1 p a b (Bazaar1 p a b a)
forall (w :: * -> * -> * -> *) a c t b.
IndexedComonad w =>
w a c t -> w a b (w b c t)
iduplicate
  {-# INLINE duplicate #-}

instance (a ~ b, Conjoined p) => ComonadApply (Bazaar1 p a b) where
  <@> :: Bazaar1 p a b (a -> b) -> Bazaar1 p a b a -> Bazaar1 p a b b
(<@>) = Bazaar1 p a b (a -> b) -> Bazaar1 p a b a -> Bazaar1 p a b b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
(<.>)
  {-# INLINE (<@>) #-}
  @> :: Bazaar1 p a b a -> Bazaar1 p a b b -> Bazaar1 p a b b
(@>) = Bazaar1 p a b a -> Bazaar1 p a b b -> Bazaar1 p a b b
forall (f :: * -> *) a b. Apply f => f a -> f b -> f b
(.>)
  {-# INLINE (@>) #-}
  <@ :: Bazaar1 p a b a -> Bazaar1 p a b b -> Bazaar1 p a b a
(<@) = Bazaar1 p a b a -> Bazaar1 p a b b -> Bazaar1 p a b a
forall (f :: * -> *) a b. Apply f => f a -> f b -> f a
(<.)
  {-# INLINE (<@) #-}

------------------------------------------------------------------------------
-- BazaarT1
------------------------------------------------------------------------------

-- | 'BazaarT1' is like 'Bazaar1', except that it provides a questionable 'Contravariant' instance
-- To protect this instance it relies on the soundness of another 'Contravariant' type, and usage conventions.
--
-- For example. This lets us write a suitably polymorphic and lazy 'Control.Lens.Traversal.taking', but there
-- must be a better way!
newtype BazaarT1 p (g :: * -> *) a b t = BazaarT1 { BazaarT1 p g a b t
-> forall (f :: * -> *). Apply f => p a (f b) -> f t
runBazaarT1 :: forall f. Apply f => p a (f b) -> f t }
type role BazaarT1 representational nominal nominal nominal nominal

-- | This alias is helpful when it comes to reducing repetition in type signatures.
--
-- @
-- type 'BazaarT1'' p g a t = 'BazaarT1' p g a a t
-- @
type BazaarT1' p g a = BazaarT1 p g a a

instance IndexedFunctor (BazaarT1 p g) where
  ifmap :: (s -> t) -> BazaarT1 p g a b s -> BazaarT1 p g a b t
ifmap s -> t
f (BazaarT1 forall (f :: * -> *). Apply f => p a (f b) -> f s
k) = (forall (f :: * -> *). Apply f => p a (f b) -> f t)
-> BazaarT1 p g a b t
forall (p :: * -> * -> *) (g :: * -> *) a b t.
(forall (f :: * -> *). Apply f => p a (f b) -> f t)
-> BazaarT1 p g a b t
BazaarT1 ((s -> t) -> f s -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap s -> t
f (f s -> f t) -> (p a (f b) -> f s) -> p a (f b) -> f t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a (f b) -> f s
forall (f :: * -> *). Apply f => p a (f b) -> f s
k)
  {-# INLINE ifmap #-}

instance Conjoined p => IndexedComonad (BazaarT1 p g) where
  iextract :: BazaarT1 p g a a t -> t
iextract (BazaarT1 forall (f :: * -> *). Apply f => p a (f a) -> f t
m) = Identity t -> t
forall a. Identity a -> a
runIdentity (Identity t -> t) -> Identity t -> t
forall a b. (a -> b) -> a -> b
$ p a (Identity a) -> Identity t
forall (f :: * -> *). Apply f => p a (f a) -> f t
m ((a -> Identity a) -> p a (Identity a)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr a -> Identity a
forall a. a -> Identity a
Identity)
  {-# INLINE iextract #-}
  iduplicate :: BazaarT1 p g a c t -> BazaarT1 p g a b (BazaarT1 p g b c t)
iduplicate (BazaarT1 forall (f :: * -> *). Apply f => p a (f c) -> f t
m) = Compose (BazaarT1 p g a b) (BazaarT1 p g b c) t
-> BazaarT1 p g a b (BazaarT1 p g b c t)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose (Compose (BazaarT1 p g a b) (BazaarT1 p g b c) t
 -> BazaarT1 p g a b (BazaarT1 p g b c t))
-> Compose (BazaarT1 p g a b) (BazaarT1 p g b c) t
-> BazaarT1 p g a b (BazaarT1 p g b c t)
forall a b. (a -> b) -> a -> b
$ p a (Compose (BazaarT1 p g a b) (BazaarT1 p g b c) c)
-> Compose (BazaarT1 p g a b) (BazaarT1 p g b c) t
forall (f :: * -> *). Apply f => p a (f c) -> f t
m (BazaarT1 p g a b (BazaarT1 p g b c c)
-> Compose (BazaarT1 p g a b) (BazaarT1 p g b c) c
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (BazaarT1 p g a b (BazaarT1 p g b c c)
 -> Compose (BazaarT1 p g a b) (BazaarT1 p g b c) c)
-> p a (BazaarT1 p g a b (BazaarT1 p g b c c))
-> p a (Compose (BazaarT1 p g a b) (BazaarT1 p g b c) c)
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. p b (BazaarT1 p g b c c)
-> p (BazaarT1 p g a b b) (BazaarT1 p g a b (BazaarT1 p g b c c))
forall (p :: * -> * -> *) (f :: * -> *) a b.
(Conjoined p, Functor f) =>
p a b -> p (f a) (f b)
distrib p b (BazaarT1 p g b c c)
forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell p (BazaarT1 p g a b b) (BazaarT1 p g a b (BazaarT1 p g b c c))
-> p a (BazaarT1 p g a b b)
-> p a (BazaarT1 p g a b (BazaarT1 p g b c c))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
C.. p a (BazaarT1 p g a b b)
forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell)
  {-# INLINE iduplicate #-}

instance Corepresentable p => Sellable p (BazaarT1 p g) where
  sell :: p a (BazaarT1 p g a b b)
sell = (Corep p a -> BazaarT1 p g a b b) -> p a (BazaarT1 p g a b b)
forall (p :: * -> * -> *) d c.
Corepresentable p =>
(Corep p d -> c) -> p d c
cotabulate ((Corep p a -> BazaarT1 p g a b b) -> p a (BazaarT1 p g a b b))
-> (Corep p a -> BazaarT1 p g a b b) -> p a (BazaarT1 p g a b b)
forall a b. (a -> b) -> a -> b
$ \ Corep p a
w -> (forall (f :: * -> *). Apply f => p a (f b) -> f b)
-> BazaarT1 p g a b b
forall (p :: * -> * -> *) (g :: * -> *) a b t.
(forall (f :: * -> *). Apply f => p a (f b) -> f t)
-> BazaarT1 p g a b t
BazaarT1 (p a (f b) -> Corep p a -> f b
forall (p :: * -> * -> *) (f :: * -> *) a b.
Cosieve p f =>
p a b -> f a -> b
`cosieve` Corep p a
w)
  {-# INLINE sell #-}

instance Profunctor p => Bizarre1 p (BazaarT1 p g) where
  bazaar1 :: p a (f b) -> BazaarT1 p g a b t -> f t
bazaar1 p a (f b)
g (BazaarT1 forall (f :: * -> *). Apply f => p a (f b) -> f t
f) = p a (f b) -> f t
forall (f :: * -> *). Apply f => p a (f b) -> f t
f p a (f b)
g
  {-# INLINE bazaar1 #-}

instance Functor (BazaarT1 p g a b) where
  fmap :: (a -> b) -> BazaarT1 p g a b a -> BazaarT1 p g a b b
fmap = (a -> b) -> BazaarT1 p g a b a -> BazaarT1 p g a b b
forall (w :: * -> * -> * -> *) s t a b.
IndexedFunctor w =>
(s -> t) -> w a b s -> w a b t
ifmap
  {-# INLINE fmap #-}
  a
x <$ :: a -> BazaarT1 p g a b b -> BazaarT1 p g a b a
<$ BazaarT1 forall (f :: * -> *). Apply f => p a (f b) -> f b
k = (forall (f :: * -> *). Apply f => p a (f b) -> f a)
-> BazaarT1 p g a b a
forall (p :: * -> * -> *) (g :: * -> *) a b t.
(forall (f :: * -> *). Apply f => p a (f b) -> f t)
-> BazaarT1 p g a b t
BazaarT1 ((a
x a -> f b -> f a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$) (f b -> f a) -> (p a (f b) -> f b) -> p a (f b) -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a (f b) -> f b
forall (f :: * -> *). Apply f => p a (f b) -> f b
k)
  {-# INLINE (<$) #-}

instance Apply (BazaarT1 p g a b) where
  BazaarT1 forall (f :: * -> *). Apply f => p a (f b) -> f (a -> b)
mf <.> :: BazaarT1 p g a b (a -> b)
-> BazaarT1 p g a b a -> BazaarT1 p g a b b
<.> BazaarT1 forall (f :: * -> *). Apply f => p a (f b) -> f a
ma = (forall (f :: * -> *). Apply f => p a (f b) -> f b)
-> BazaarT1 p g a b b
forall (p :: * -> * -> *) (g :: * -> *) a b t.
(forall (f :: * -> *). Apply f => p a (f b) -> f t)
-> BazaarT1 p g a b t
BazaarT1 ((forall (f :: * -> *). Apply f => p a (f b) -> f b)
 -> BazaarT1 p g a b b)
-> (forall (f :: * -> *). Apply f => p a (f b) -> f b)
-> BazaarT1 p g a b b
forall a b. (a -> b) -> a -> b
$ \ p a (f b)
pafb -> p a (f b) -> f (a -> b)
forall (f :: * -> *). Apply f => p a (f b) -> f (a -> b)
mf p a (f b)
pafb f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> p a (f b) -> f a
forall (f :: * -> *). Apply f => p a (f b) -> f a
ma p a (f b)
pafb
  {-# INLINE (<.>) #-}
  BazaarT1 forall (f :: * -> *). Apply f => p a (f b) -> f a
mf .> :: BazaarT1 p g a b a -> BazaarT1 p g a b b -> BazaarT1 p g a b b
.> BazaarT1 forall (f :: * -> *). Apply f => p a (f b) -> f b
ma = (forall (f :: * -> *). Apply f => p a (f b) -> f b)
-> BazaarT1 p g a b b
forall (p :: * -> * -> *) (g :: * -> *) a b t.
(forall (f :: * -> *). Apply f => p a (f b) -> f t)
-> BazaarT1 p g a b t
BazaarT1 ((forall (f :: * -> *). Apply f => p a (f b) -> f b)
 -> BazaarT1 p g a b b)
-> (forall (f :: * -> *). Apply f => p a (f b) -> f b)
-> BazaarT1 p g a b b
forall a b. (a -> b) -> a -> b
$ \ p a (f b)
pafb -> p a (f b) -> f a
forall (f :: * -> *). Apply f => p a (f b) -> f a
mf p a (f b)
pafb f a -> f b -> f b
forall (f :: * -> *) a b. Apply f => f a -> f b -> f b
.> p a (f b) -> f b
forall (f :: * -> *). Apply f => p a (f b) -> f b
ma p a (f b)
pafb
  {-# INLINE (.>) #-}
  BazaarT1 forall (f :: * -> *). Apply f => p a (f b) -> f a
mf <. :: BazaarT1 p g a b a -> BazaarT1 p g a b b -> BazaarT1 p g a b a
<. BazaarT1 forall (f :: * -> *). Apply f => p a (f b) -> f b
ma = (forall (f :: * -> *). Apply f => p a (f b) -> f a)
-> BazaarT1 p g a b a
forall (p :: * -> * -> *) (g :: * -> *) a b t.
(forall (f :: * -> *). Apply f => p a (f b) -> f t)
-> BazaarT1 p g a b t
BazaarT1 ((forall (f :: * -> *). Apply f => p a (f b) -> f a)
 -> BazaarT1 p g a b a)
-> (forall (f :: * -> *). Apply f => p a (f b) -> f a)
-> BazaarT1 p g a b a
forall a b. (a -> b) -> a -> b
$ \ p a (f b)
pafb -> p a (f b) -> f a
forall (f :: * -> *). Apply f => p a (f b) -> f a
mf p a (f b)
pafb f a -> f b -> f a
forall (f :: * -> *) a b. Apply f => f a -> f b -> f a
<. p a (f b) -> f b
forall (f :: * -> *). Apply f => p a (f b) -> f b
ma p a (f b)
pafb
  {-# INLINE (<.) #-}

instance (a ~ b, Conjoined p) => Comonad (BazaarT1 p g a b) where
  extract :: BazaarT1 p g a b a -> a
extract = BazaarT1 p g a b a -> a
forall (w :: * -> * -> * -> *) a t.
IndexedComonad w =>
w a a t -> t
iextract
  {-# INLINE extract #-}
  duplicate :: BazaarT1 p g a b a -> BazaarT1 p g a b (BazaarT1 p g a b a)
duplicate = BazaarT1 p g a b a -> BazaarT1 p g a b (BazaarT1 p g a b a)
forall (w :: * -> * -> * -> *) a c t b.
IndexedComonad w =>
w a c t -> w a b (w b c t)
iduplicate
  {-# INLINE duplicate #-}

instance (a ~ b, Conjoined p) => ComonadApply (BazaarT1 p g a b) where
  <@> :: BazaarT1 p g a b (a -> b)
-> BazaarT1 p g a b a -> BazaarT1 p g a b b
(<@>) = BazaarT1 p g a b (a -> b)
-> BazaarT1 p g a b a -> BazaarT1 p g a b b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
(<.>)
  {-# INLINE (<@>) #-}
  @> :: BazaarT1 p g a b a -> BazaarT1 p g a b b -> BazaarT1 p g a b b
(@>) = BazaarT1 p g a b a -> BazaarT1 p g a b b -> BazaarT1 p g a b b
forall (f :: * -> *) a b. Apply f => f a -> f b -> f b
(.>)
  {-# INLINE (@>) #-}
  <@ :: BazaarT1 p g a b a -> BazaarT1 p g a b b -> BazaarT1 p g a b a
(<@) = BazaarT1 p g a b a -> BazaarT1 p g a b b -> BazaarT1 p g a b a
forall (f :: * -> *) a b. Apply f => f a -> f b -> f a
(<.)
  {-# INLINE (<@) #-}

instance (Profunctor p, Contravariant g) => Contravariant (BazaarT1 p g a b) where
  contramap :: (a -> b) -> BazaarT1 p g a b b -> BazaarT1 p g a b a
contramap a -> b
_ = a -> BazaarT1 p g a b b -> BazaarT1 p g a b a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
(<$) ([Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"contramap: BazaarT1")
  {-# INLINE contramap #-}

instance Contravariant g => Semigroup (BazaarT1 p g a b t) where
  BazaarT1 forall (f :: * -> *). Apply f => p a (f b) -> f t
a <> :: BazaarT1 p g a b t -> BazaarT1 p g a b t -> BazaarT1 p g a b t
<> BazaarT1 forall (f :: * -> *). Apply f => p a (f b) -> f t
b = (forall (f :: * -> *). Apply f => p a (f b) -> f t)
-> BazaarT1 p g a b t
forall (p :: * -> * -> *) (g :: * -> *) a b t.
(forall (f :: * -> *). Apply f => p a (f b) -> f t)
-> BazaarT1 p g a b t
BazaarT1 ((forall (f :: * -> *). Apply f => p a (f b) -> f t)
 -> BazaarT1 p g a b t)
-> (forall (f :: * -> *). Apply f => p a (f b) -> f t)
-> BazaarT1 p g a b t
forall a b. (a -> b) -> a -> b
$ \p a (f b)
f -> p a (f b) -> f t
forall (f :: * -> *). Apply f => p a (f b) -> f t
a p a (f b)
f f t -> f t -> f t
forall (f :: * -> *) a b. Apply f => f a -> f b -> f a
<. p a (f b) -> f t
forall (f :: * -> *). Apply f => p a (f b) -> f t
b p a (f b)
f
  {-# INLINE (<>) #-}