#if __GLASGOW_HASKELL__ >= 707
#endif
module Control.Lens.Internal.Bazaar
( Bizarre(..)
, Bazaar(..), Bazaar'
, BazaarT(..), BazaarT'
, Bizarre1(..)
, Bazaar1(..), Bazaar1'
, BazaarT1(..), BazaarT1'
) where
import Control.Applicative
import Control.Arrow as Arrow
import Control.Category
import Control.Comonad
import Control.Lens.Internal.Context
import Control.Lens.Internal.Indexed
import Data.Functor.Apply
import Data.Functor.Compose
import Data.Functor.Contravariant
import Data.Functor.Identity
import Data.Semigroup
import Data.Profunctor
import Data.Profunctor.Rep
import Data.Profunctor.Sieve
import Data.Profunctor.Unsafe
import Prelude hiding ((.),id)
class Profunctor p => Bizarre p w | w -> p where
bazaar :: Applicative f => p a (f b) -> w a b t -> f t
newtype Bazaar p a b t = Bazaar { runBazaar :: forall f. Applicative f => p a (f b) -> f t }
type Bazaar' p a = Bazaar p a a
instance IndexedFunctor (Bazaar p) where
ifmap f (Bazaar k) = Bazaar (fmap f . k)
instance Conjoined p => IndexedComonad (Bazaar p) where
iextract (Bazaar m) = runIdentity $ m (arr Identity)
iduplicate (Bazaar m) = getCompose $ m (Compose #. distrib sell . sell)
instance Corepresentable p => Sellable p (Bazaar p) where
sell = cotabulate $ \ w -> Bazaar $ tabulate $ \k -> pure (cosieve k w)
instance Profunctor p => Bizarre p (Bazaar p) where
bazaar g (Bazaar f) = f g
instance Functor (Bazaar p a b) where
fmap = ifmap
instance Apply (Bazaar p a b) where
Bazaar mf <.> Bazaar ma = Bazaar $ \ pafb -> mf pafb <*> ma pafb
instance Applicative (Bazaar p a b) where
pure a = Bazaar $ \_ -> pure a
Bazaar mf <*> Bazaar ma = Bazaar $ \ pafb -> mf pafb <*> ma pafb
instance (a ~ b, Conjoined p) => Comonad (Bazaar p a b) where
extract = iextract
duplicate = iduplicate
instance (a ~ b, Conjoined p) => ComonadApply (Bazaar p a b) where
(<@>) = (<*>)
newtype BazaarT p (g :: * -> *) a b t = BazaarT { runBazaarT :: forall f. Applicative f => p a (f b) -> f t }
#if __GLASGOW_HASKELL__ >= 707
type role BazaarT representational nominal nominal nominal nominal
#endif
type BazaarT' p g a = BazaarT p g a a
instance IndexedFunctor (BazaarT p g) where
ifmap f (BazaarT k) = BazaarT (fmap f . k)
instance Conjoined p => IndexedComonad (BazaarT p g) where
iextract (BazaarT m) = runIdentity $ m (arr Identity)
iduplicate (BazaarT m) = getCompose $ m (Compose #. distrib sell . sell)
instance Corepresentable p => Sellable p (BazaarT p g) where
sell = cotabulate $ \ w -> BazaarT (`cosieve` w)
instance Profunctor p => Bizarre p (BazaarT p g) where
bazaar g (BazaarT f) = f g
instance Functor (BazaarT p g a b) where
fmap = ifmap
instance Apply (BazaarT p g a b) where
BazaarT mf <.> BazaarT ma = BazaarT $ \ pafb -> mf pafb <*> ma pafb
instance Applicative (BazaarT p g a b) where
pure a = BazaarT $ tabulate $ \_ -> pure (pure a)
BazaarT mf <*> BazaarT ma = BazaarT $ \ pafb -> mf pafb <*> ma pafb
instance (a ~ b, Conjoined p) => Comonad (BazaarT p g a b) where
extract = iextract
duplicate = iduplicate
instance (a ~ b, Conjoined p) => ComonadApply (BazaarT p g a b) where
(<@>) = (<*>)
instance (Profunctor p, Contravariant g) => Contravariant (BazaarT p g a b) where
contramap _ = (<$) (error "contramap: BazaarT")
instance Contravariant g => Semigroup (BazaarT p g a b t) where
BazaarT a <> BazaarT b = BazaarT $ \f -> a f <* b f
instance Contravariant g => Monoid (BazaarT p g a b t) where
mempty = BazaarT $ \_ -> pure (error "mempty: BazaarT")
BazaarT a `mappend` BazaarT b = BazaarT $ \f -> a f <* b f
class Profunctor p => Bizarre1 p w | w -> p where
bazaar1 :: Apply f => p a (f b) -> w a b t -> f t
newtype Bazaar1 p a b t = Bazaar1 { runBazaar1 :: forall f. Apply f => p a (f b) -> f t }
type Bazaar1' p a = Bazaar1 p a a
instance IndexedFunctor (Bazaar1 p) where
ifmap f (Bazaar1 k) = Bazaar1 (fmap f . k)
instance Conjoined p => IndexedComonad (Bazaar1 p) where
iextract (Bazaar1 m) = runIdentity $ m (arr Identity)
iduplicate (Bazaar1 m) = getCompose $ m (Compose #. distrib sell . sell)
instance Corepresentable p => Sellable p (Bazaar1 p) where
sell = cotabulate $ \ w -> Bazaar1 $ tabulate $ \k -> pure (cosieve k w)
instance Profunctor p => Bizarre1 p (Bazaar1 p) where
bazaar1 g (Bazaar1 f) = f g
instance Functor (Bazaar1 p a b) where
fmap = ifmap
instance Apply (Bazaar1 p a b) where
Bazaar1 mf <.> Bazaar1 ma = Bazaar1 $ \ pafb -> mf pafb <.> ma pafb
instance (a ~ b, Conjoined p) => Comonad (Bazaar1 p a b) where
extract = iextract
duplicate = iduplicate
instance (a ~ b, Conjoined p) => ComonadApply (Bazaar1 p a b) where
Bazaar1 mf <@> Bazaar1 ma = Bazaar1 $ \ pafb -> mf pafb <.> ma pafb
newtype BazaarT1 p (g :: * -> *) a b t = BazaarT1 { runBazaarT1 :: forall f. Apply f => p a (f b) -> f t }
#if __GLASGOW_HASKELL__ >= 707
type role BazaarT1 representational nominal nominal nominal nominal
#endif
type BazaarT1' p g a = BazaarT1 p g a a
instance IndexedFunctor (BazaarT1 p g) where
ifmap f (BazaarT1 k) = BazaarT1 (fmap f . k)
instance Conjoined p => IndexedComonad (BazaarT1 p g) where
iextract (BazaarT1 m) = runIdentity $ m (arr Identity)
iduplicate (BazaarT1 m) = getCompose $ m (Compose #. distrib sell . sell)
instance Corepresentable p => Sellable p (BazaarT1 p g) where
sell = cotabulate $ \ w -> BazaarT1 (`cosieve` w)
instance Profunctor p => Bizarre1 p (BazaarT1 p g) where
bazaar1 g (BazaarT1 f) = f g
instance Functor (BazaarT1 p g a b) where
fmap = ifmap
instance Apply (BazaarT1 p g a b) where
BazaarT1 mf <.> BazaarT1 ma = BazaarT1 $ \ pafb -> mf pafb <.> ma pafb
instance (a ~ b, Conjoined p) => Comonad (BazaarT1 p g a b) where
extract = iextract
duplicate = iduplicate
instance (a ~ b, Conjoined p) => ComonadApply (BazaarT1 p g a b) where
BazaarT1 mf <@> BazaarT1 ma = BazaarT1 $ \ pafb -> mf pafb <.> ma pafb
instance (Profunctor p, Contravariant g) => Contravariant (BazaarT1 p g a b) where
contramap _ = (<$) (error "contramap: BazaarT1")
instance Contravariant g => Semigroup (BazaarT1 p g a b t) where
BazaarT1 a <> BazaarT1 b = BazaarT1 $ \f -> a f <. b f