diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,14 @@ ## Upcoming +## 0.2.2.0 -- 2023-06-26 + +* Adds `co-log` example. +* Switch to Ormolu formatting and a `Makefile` to manage local development. +* Remove Arrow terminology from haddocks. +* Adds missing `Star` and `Kleisli` instances. +* Adds `Unital` and `Monoidal` instances for `Divisible` and `Decidable`. + ## 0.2.1.0 -- 2023-01-29 * Rewrite `Semigroupal`, `Unital`, and `Monoidal` `Functor` instances diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,3 @@ import Distribution.Simple + main = defaultMain diff --git a/examples/co-log/Main.hs b/examples/co-log/Main.hs new file mode 100644 --- /dev/null +++ b/examples/co-log/Main.hs @@ -0,0 +1,188 @@ +module Main where + +-------------------------------------------------------------------------------- + +import Control.Category +import Control.Category.Cartesian +import Control.Category.Tensor +import Control.Monad.IO.Class +import Control.Monad.Reader +import Control.Monad.Trans +import Data.Coerce +import Data.Functor.Contravariant hiding ((>$<)) +import Data.Functor.Contravariant.Divisible hiding (divide) +import Data.Functor.Monoidal +import Data.Kind +import Data.Void +import Prelude hiding (id, (.)) + +-------------------------------------------------------------------------------- + +main :: IO () +main = runCarExample + +-------------------------------------------------------------------------------- +-- Car Example from co-log blog post +-- https://kowainik.github.io/posts/2018-09-25-co-log#combinators + +data Engine = Pistons Int | Rocket + +data Car = Car + { carMake :: String, + carModel :: String, + carEngine :: Engine + } + +engineToEither :: Engine -> Either Int () +engineToEither e = case e of + Pistons i -> Left i + Rocket -> Right () + +carToTuple :: Car -> (String, (String, Engine)) +carToTuple (Car make model engine) = (make, (model, engine)) + +carL :: LogAction IO Car +carL = + carToTuple + >$< (constL "Logging make..." *< showL >* constL "Finished logging make...") + >*< (constL "Logging model.." *< showL >* constL "Finished logging model...") + >*< ( engineToEither + >$< constL "Logging pistons..." + *< intL + >|< constL "Logging rocket..." + ) + +runCarExample :: IO () +runCarExample = usingLoggerT carL $ logMsg $ Car "Toyota" "Corolla" (Pistons 4) + +-------------------------------------------------------------------------------- + +newtype LogAction m msg = LogAction {unLogAction :: msg -> m ()} + +instance Contravariant (LogAction m) where + contramap :: (a -> b) -> LogAction m b -> LogAction m a + contramap f (LogAction act) = LogAction $ \a -> act (f a) + +instance Applicative m => Semigroupal (->) (,) (,) (LogAction m) where + combine :: (LogAction m a, LogAction m b) -> LogAction m (a, b) + combine (act1, act2) = LogAction $ \(a, b) -> + unLogAction act1 a + *> unLogAction act2 b + *> pure () + +instance Applicative m => Unital (->) () () (LogAction m) where + introduce :: () -> LogAction m () + introduce () = LogAction $ \_ -> pure () + +instance Applicative m => Semigroupal (->) Either (,) (LogAction m) where + combine :: (LogAction m a, LogAction m b) -> LogAction m (Either a b) + combine (act1, act2) = LogAction $ \case + Left a -> coerce act1 a + Right b -> coerce act2 b + +instance Applicative m => Unital (->) Void () (LogAction m) where + introduce :: () -> LogAction m Void + introduce () = LogAction $ \_ -> pure () + +-- NOTE: We don't actually need these instances but include them to demonstrate the equivalence: +-- instance Applicative m => Semigroup (LogAction m a) where +-- act1 <> act2 = contramap (split @_ @(,)) $ combine (act1, act2) +-- +-- instance Applicative m => Monoid (LogAction m a) where +-- mempty = contramap (\_ -> ()) $ introduce () +-- +-- instance Applicative m => Divisible (LogAction m) where +-- conquer :: LogAction m a +-- conquer = mempty +-- +-- divide :: (a -> (b, c)) -> LogAction m b -> LogAction m c -> LogAction m a +-- divide f act1 act2 = contramap f $ combine (act1, act2) +-- +-- instance Applicative m => Decidable (LogAction m) where +-- lose :: (a -> Void) -> LogAction m a +-- lose f = contramap f $ introduce @_ @Void () +-- +-- choose :: (a -> Either b c) -> LogAction m b -> LogAction m c -> LogAction m a +-- choose f act1 act2 = contramap f $ combine @_ @Either (act1, act2) + +-------------------------------------------------------------------------------- +-- Combinators + +divide :: (Contravariant f, Semigroupal (->) (,) (,) f) => (a -> (b, c)) -> f b -> f c -> f a +divide f fb fc = curry (contramap f . combine) fb fc + +infixr 3 >$< + +(>$<) :: (a -> b) -> LogAction m b -> LogAction m a +(>$<) = contramap + +infixr 4 >*< + +(>*<) :: Semigroupal (->) (,) (,) f => f a -> f b -> f (a, b) +(>*<) = (|?|) + +infixr 3 >|< + +(>|<) :: Semigroupal (->) Either (,) f => f a -> f b -> f (Either a b) +(>|<) = (|?|) + +infixr 4 >* + +(>*) :: (Contravariant f, (Semigroupal (->) (,) (,) f)) => f a -> f () -> f a +(>*) = divide (,()) + +infixr 4 *< + +(*<) :: (Contravariant f, (Semigroupal (->) (,) (,) f)) => f () -> f a -> f a +(*<) = divide ((),) + +-------------------------------------------------------------------------------- +-- Log Actions + +hoistLogAction :: (forall x. m x -> n x) -> LogAction m a -> LogAction n a +hoistLogAction nat (LogAction act) = LogAction $ nat . act + +liftLogAction :: (Monad m, MonadTrans t) => LogAction m msg -> LogAction (t m) msg +liftLogAction = hoistLogAction lift + +logStringStdout :: LogAction IO String +logStringStdout = LogAction putStrLn + +-- Combinator that allows to log any showable value +showL :: Show a => LogAction IO a +showL = contramap show logStringStdout + +-- Returns a log action that logs a given string ignoring its input. +constL :: String -> LogAction IO a +constL s = s >$ logStringStdout + +intL :: LogAction IO Int +intL = showL + +-------------------------------------------------------------------------------- + +class HasLog env msg (m :: Type -> Type) where + getLogAction :: env -> LogAction m msg + setLogAction :: LogAction m msg -> env -> env + +instance HasLog (LogAction m msg) msg m where + getLogAction :: LogAction m msg -> LogAction m msg + getLogAction = id + + setLogAction :: LogAction m msg -> LogAction m msg -> LogAction m msg + setLogAction = const + +logMsg :: (MonadReader env m, HasLog env msg m) => msg -> m () +logMsg msg = do + LogAction logger <- asks getLogAction + logger msg + +usingLoggerT :: Monad m => LogAction m msg -> LoggerT msg m a -> m a +usingLoggerT action = flip runReaderT (liftLogAction action) . runLoggerT + +newtype LoggerT msg m a = LoggerT {runLoggerT :: ReaderT (LogAction (LoggerT msg m) msg) m a} + deriving newtype (Functor, Applicative, Monad, MonadIO, MonadReader (LogAction (LoggerT msg m) msg)) + +instance MonadTrans (LoggerT msg) where + lift :: Monad m => m a -> LoggerT msg m a + lift = LoggerT . lift diff --git a/monoidal-functors.cabal b/monoidal-functors.cabal --- a/monoidal-functors.cabal +++ b/monoidal-functors.cabal @@ -1,7 +1,7 @@ cabal-version: 2.4 name: monoidal-functors category: Control, Categories -version: 0.2.1.0 +version: 0.2.2.0 license: MIT license-file: LICENSE author: Solomon Bothwell & Asad Saeeduddin @@ -18,18 +18,47 @@ -------------------------------------------------------------------------------- +common common-extensions + default-extensions: + ConstraintKinds + DeriveFunctor + DerivingVia + FunctionalDependencies + FlexibleInstances + FlexibleContexts + GeneralizedNewtypeDeriving + ImportQualifiedPost + InstanceSigs + KindSignatures + LambdaCase + MultiParamTypeClasses + NoImplicitPrelude + QuantifiedConstraints + RankNTypes + ScopedTypeVariables + StandaloneDeriving + TupleSections + TypeApplications + TypeOperators + UndecidableInstances + +-------------------------------------------------------------------------------- + library + import: common-extensions build-depends: - base >= 4.12 && < 5, - bifunctors >= 5.5.11 && < 5.6, - comonad >= 5.0.8 && < 5.1, - distributive >= 0.6.2 && < 0.7, - tagged >= 0.8.6 && < 0.9, - contravariant >= 1.5.5 && < 1.6, - profunctors >= 5.6.2 && < 5.7, - semialign >= 1.2.0 && < 1.3, - semigroupoids >= 5.3.6 && < 5.4, - these >= 1.1.1 && < 1.2, + base >= 4.12 && < 4.18, + bifunctors >= 5.6.1 && < 5.7, + tagged >= 0.8.7 && < 0.9, + transformers >= 0.5.6 && <= 0.6.1.0, + comonad >= 5.0.8 && < 5.1, + distributive >= 0.6.2 && < 0.7, + contravariant >= 1.5.5 && < 1.6, + profunctors >= 5.6.2 && < 5.7, + semialign >= 1.3 && < 1.4, + semigroupoids >= 6.0.0 && < 6.1, + these >= 1.2 && < 1.3, + mtl >= 2.2.2 && <= 2.3.1, exposed-modules: Control.Category.Tensor @@ -58,25 +87,17 @@ hs-source-dirs: src default-language: Haskell2010 - - default-extensions: - ConstraintKinds - DeriveFunctor - DerivingVia - FunctionalDependencies - FlexibleInstances - FlexibleContexts - GeneralizedNewtypeDeriving - InstanceSigs - KindSignatures - LambdaCase - MultiParamTypeClasses - NoImplicitPrelude - QuantifiedConstraints - RankNTypes - ScopedTypeVariables - StandaloneDeriving - TypeApplications - TypeOperators - UndecidableInstances +-------------------------------------------------------------------------------- + +executable co-log + import: common-extensions + hs-source-dirs: examples/co-log + main-is: Main.hs + build-depends: base + , bifunctors + , contravariant + , distributive + , monoidal-functors + , mtl + default-language: Haskell2010 diff --git a/src/Control/Category/Tensor.hs b/src/Control/Category/Tensor.hs --- a/src/Control/Category/Tensor.hs +++ b/src/Control/Category/Tensor.hs @@ -1,4 +1,5 @@ {-# LANGUAGE MonoLocalBinds #-} + module Control.Category.Tensor ( -- * Iso Iso (..), @@ -8,6 +9,7 @@ (#), grmap, glmap, + -- * Associative Associative (..), @@ -22,6 +24,7 @@ -------------------------------------------------------------------------------- import Control.Applicative (Applicative (..)) +import Control.Arrow (Kleisli (..)) import Control.Category (Category (..)) import Data.Biapplicative (Biapplicative (..), Bifunctor (..)) import Data.Functor.Contravariant (Op (..)) @@ -40,7 +43,7 @@ -- 'fwd' '.' 'bwd' ≡ 'id' -- 'bwd' '.' 'fwd' ≡ 'id' -- @ -data Iso cat a b = Iso { fwd :: cat a b, bwd :: cat b a } +data Iso cat a b = Iso {fwd :: cat a b, bwd :: cat b a} instance Category cat => Category (Iso cat) where id :: Iso cat a a @@ -82,11 +85,12 @@ -- -- >>> getOp (gbimap @Op @Op @Op @Either (Op (+ 1)) (Op show)) (Right True) -- Right "True" - gbimap :: cat1 a b -> cat2 c d -> cat3 (a `t` c) (b `t` d) + gbimap :: cat1 a b -> cat2 c d -> cat3 (a `t` c) (b `t` d) -- | Infix operator for 'gbimap'. infixr 9 # -(#) :: GBifunctor cat1 cat2 cat3 t => cat1 a b -> cat2 c d -> cat3 (a `t` c) (b `t` d) + +(#) :: GBifunctor cat1 cat2 cat3 t => cat1 a b -> cat2 c d -> cat3 (a `t` c) (b `t` d) (#) = gbimap -- | Covariantally map over the right variable. @@ -108,10 +112,18 @@ gbimap :: Star Maybe a b -> Star Maybe c d -> Star Maybe (These a c) (These b d) gbimap (Star f) (Star g) = Star $ \case - This a -> This <$> f a - That c -> That <$> g c + This a -> This <$> f a + That c -> That <$> g c These a c -> liftA2 These (f a) (g c) +instance GBifunctor (Kleisli Maybe) (Kleisli Maybe) (Kleisli Maybe) These where + gbimap :: Kleisli Maybe a b -> Kleisli Maybe c d -> Kleisli Maybe (These a c) (These b d) + gbimap (Kleisli f) (Kleisli g) = + Kleisli $ \case + This a -> This <$> f a + That c -> That <$> g c + These a c -> liftA2 These (f a) (g c) + instance GBifunctor cat cat cat t => GBifunctor (Iso cat) (Iso cat) (Iso cat) t where gbimap :: Iso cat a b -> Iso cat c d -> Iso cat (t a c) (t b d) gbimap iso1 iso2 = Iso (gbimap (fwd iso1) (fwd iso2)) (gbimap (bwd iso1) (bwd iso2)) @@ -136,7 +148,7 @@ -- -- ==== __Examples__ -- - -- >>> :t assoc @(->) @(,) + -- >>> :t assoc @(->) @(,) -- assoc @(->) @(,) :: Iso (->) (a, (b, c)) ((a, b), c) -- -- >>> fwd (assoc @(->) @(,)) (1, ("hello", True)) @@ -145,39 +157,52 @@ instance Associative (->) t => Associative Op t where assoc :: Iso Op (a `t` (b `t` c)) ((a `t` b) `t` c) - assoc = Iso - { fwd = Op $ bwd assoc - , bwd = Op $ fwd assoc - } + assoc = + Iso + { fwd = Op $ bwd assoc, + bwd = Op $ fwd assoc + } instance Associative (->) (,) where assoc :: Iso (->) (a, (b, c)) ((a, b), c) - assoc = Iso - { fwd = \(a, (b, c)) -> ((a, b), c) - , bwd = \((a, b), c) -> (a, (b, c)) - } + assoc = + Iso + { fwd = \(a, (b, c)) -> ((a, b), c), + bwd = \((a, b), c) -> (a, (b, c)) + } instance Associative (->) Either where assoc :: Iso (->) (Either a (Either b c)) (Either (Either a b) c) - assoc = Iso - { fwd = either (Left . Left) (either (Left . Right) Right) - , bwd = either (fmap Left) (Right . Right) - } + assoc = + Iso + { fwd = either (Left . Left) (either (Left . Right) Right), + bwd = either (fmap Left) (Right . Right) + } instance Associative (->) These where assoc :: Iso (->) (These a (These b c)) (These (These a b) c) - assoc = Iso - { fwd = these (This . This) (glmap That) (glmap . These) - , bwd = these (grmap This) (That . That) (flip $ grmap . flip These) - } + assoc = + Iso + { fwd = these (This . This) (glmap That) (glmap . These), + bwd = these (grmap This) (That . That) (flip $ grmap . flip These) + } instance (Monad m, Associative (->) t, GBifunctor (Star m) (Star m) (Star m) t) => Associative (Star m) t where assoc :: Iso (Star m) (a `t` (b `t` c)) ((a `t` b) `t` c) - assoc = Iso - { fwd = (`rmap` id) (fwd assoc) - , bwd = (`rmap` id) (bwd assoc) - } + assoc = + Iso + { fwd = (`rmap` id) (fwd assoc), + bwd = (`rmap` id) (bwd assoc) + } +instance (Monad m, Associative (->) t, GBifunctor (Kleisli m) (Kleisli m) (Kleisli m) t) => Associative (Kleisli m) t where + assoc :: Iso (Kleisli m) (a `t` (b `t` c)) ((a `t` b) `t` c) + assoc = + Iso + { fwd = (`rmap` id) (fwd assoc), + bwd = (`rmap` id) (bwd assoc) + } + -------------------------------------------------------------------------------- -- | A bifunctor \(\_ \otimes\_ \ : \mathcal{C} \times \mathcal{C} \to \mathcal{C}\) @@ -194,7 +219,7 @@ -- 'fwd' 'unitr' (a ⊗ i) ≡ a -- 'bwd' 'unitr' a ≡ (a ⊗ i) -- --- 'fwd' 'unitl' (i ⊗ a) ≡ a +-- 'fwd' 'unitl' (i ⊗ a) ≡ a -- 'bwd' 'unitl' a ≡ (i ⊗ a) -- @ class Associative cat t => Tensor cat t i | t -> i where @@ -204,7 +229,7 @@ -- -- >>> fwd (unitl @_ @(,)) ((), True) -- True - -- + -- -- >>> bwd (unitl @_ @(,)) True -- ((),True) -- @@ -214,13 +239,14 @@ -- >>> :t bwd (unitl @_ @Either) True -- bwd (unitl @_ @Either) True :: Either Void Bool unitl :: Iso cat (i `t` a) a + -- | The between @(a \`t\` i)@ and @a@. -- -- ==== __Examples__ -- -- >>> fwd (unitr @_ @(,)) (True, ()) -- True - -- + -- -- >>> bwd (unitr @_ @(,)) True -- (True,()) -- @@ -233,69 +259,94 @@ instance (Tensor (->) t i) => Tensor Op t i where unitl :: Iso Op (i `t` a) a - unitl = Iso - { fwd = Op $ bwd unitl - , bwd = Op $ fwd unitl - } + unitl = + Iso + { fwd = Op $ bwd unitl, + bwd = Op $ fwd unitl + } unitr :: Iso Op (a `t` i) a - unitr = Iso - { fwd = Op $ bwd unitr - , bwd = Op $ fwd unitr - } + unitr = + Iso + { fwd = Op $ bwd unitr, + bwd = Op $ fwd unitr + } instance Tensor (->) (,) () where unitl :: Iso (->) ((), a) a - unitl = Iso - { fwd = snd - , bwd = bipure () - } + unitl = + Iso + { fwd = snd, + bwd = bipure () + } unitr :: Iso (->) (a, ()) a - unitr = Iso - { fwd = fst - , bwd = (`bipure` ()) - } + unitr = + Iso + { fwd = fst, + bwd = (`bipure` ()) + } instance Tensor (->) Either Void where unitl :: Iso (->) (Either Void a) a - unitl = Iso - { fwd = either absurd id - , bwd = pure - } + unitl = + Iso + { fwd = either absurd id, + bwd = pure + } unitr :: Iso (->) (Either a Void) a - unitr = Iso - { fwd = either id absurd - , bwd = Left - } + unitr = + Iso + { fwd = either id absurd, + bwd = Left + } instance Tensor (->) These Void where unitl :: Iso (->) (These Void a) a - unitl = Iso - { fwd = these absurd id (\ _ x -> x) - , bwd = That - } + unitl = + Iso + { fwd = these absurd id (\_ x -> x), + bwd = That + } unitr :: Iso (->) (These a Void) a - unitr = Iso - { fwd = these id absurd const - , bwd = This - } + unitr = + Iso + { fwd = these id absurd const, + bwd = This + } instance (Monad m, Tensor (->) t i, Associative (Star m) t) => Tensor (Star m) t i where unitl :: Iso (Star m) (i `t` a) a - unitl = Iso - { fwd = (`rmap` id) (fwd unitl) - , bwd = (`rmap` id) (bwd unitl) - } + unitl = + Iso + { fwd = (`rmap` id) (fwd unitl), + bwd = (`rmap` id) (bwd unitl) + } unitr :: Iso (Star m) (a `t` i) a - unitr = Iso - { fwd = (`rmap` id) (fwd unitr) - , bwd = (`rmap` id) (bwd unitr) - } + unitr = + Iso + { fwd = (`rmap` id) (fwd unitr), + bwd = (`rmap` id) (bwd unitr) + } +instance (Monad m, Tensor (->) t i, Associative (Kleisli m) t) => Tensor (Kleisli m) t i where + unitl :: Iso (Kleisli m) (i `t` a) a + unitl = + Iso + { fwd = (`rmap` id) (fwd unitl), + bwd = (`rmap` id) (bwd unitl) + } + + unitr :: Iso (Kleisli m) (a `t` i) a + unitr = + Iso + { fwd = (`rmap` id) (fwd unitr), + bwd = (`rmap` id) (bwd unitr) + } + -------------------------------------------------------------------------------- -- | A bifunctor \(\_ \otimes\_ \ : \mathcal{C} \times \mathcal{C} \to \mathcal{C}\) @@ -344,3 +395,7 @@ instance (Monad m, Symmetric (->) t, Associative (Star m) t) => Symmetric (Star m) t where swap :: Star m (a `t` b) (b `t` a) swap = Star $ pure . swap + +instance (Monad m, Symmetric (->) t, Associative (Kleisli m) t) => Symmetric (Kleisli m) t where + swap :: Kleisli m (a `t` b) (b `t` a) + swap = Kleisli $ pure . swap diff --git a/src/Control/Category/Tensor/Expr.hs b/src/Control/Category/Tensor/Expr.hs --- a/src/Control/Category/Tensor/Expr.hs +++ b/src/Control/Category/Tensor/Expr.hs @@ -1,11 +1,12 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneKindSignatures #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} + module Control.Category.Tensor.Expr ( -- * Type Families MConcat, @@ -37,7 +38,7 @@ -- let bar :: Tensored Either Void '[Bool, Int] -- bar = Tensored $ Right $ Left 8 -- :} --- +-- -- >>> :{ -- let baz :: Tensored These Void '[Bool, Int] -- baz = Tensored $ These True $ This 8 @@ -47,28 +48,26 @@ MConcat mappend mempty '[] = mempty MConcat mappend mempty (x ': xs) = mappend x (MConcat mappend mempty xs) -newtype Tensored t i xs = Tensored { getTensored :: MConcat t i xs } +newtype Tensored t i xs = Tensored {getTensored :: MConcat t i xs} deriving newtype instance Show (MConcat t i xs) => Show (Tensored t i xs) + deriving newtype instance Eq (MConcat t i xs) => Eq (Tensored t i xs) + deriving newtype instance Ord (MConcat t i xs) => Ord (Tensored t i xs) -------------------------------------------------------------------------------- type (++) :: [k] -> [k] -> [k] -type family xs ++ ys - where +type family xs ++ ys where '[] ++ xs = xs (x ': xs) ++ ys = x ': (xs ++ ys) class AppendTensored xs where appendTensored :: Tensor (->) t i => Tensored t i xs `t` Tensored t i ys -> Tensored t i (xs ++ ys) -instance AppendTensored '[] - where +instance AppendTensored '[] where appendTensored = fwd unitl . glmap getTensored -instance AppendTensored xs => AppendTensored (x ': xs) - where +instance AppendTensored xs => AppendTensored (x ': xs) where appendTensored = Tensored . grmap (getTensored . appendTensored @xs . glmap Tensored) . bwd assoc . glmap getTensored - diff --git a/src/Data/Bifunctor/BiInvariant.hs b/src/Data/Bifunctor/BiInvariant.hs --- a/src/Data/Bifunctor/BiInvariant.hs +++ b/src/Data/Bifunctor/BiInvariant.hs @@ -78,85 +78,141 @@ biinvIso (Iso f f') (Iso g g') = Iso (biinvmap f' f g' g) (biinvmap f f' g g') -- | Boilerplate newtype to derive 'BiInvariant' for any 'Profunctor'. -newtype FromProfunctor p a b = FromProfunctor { runPro :: p a b} +newtype FromProfunctor p a b = FromProfunctor {runPro :: p a b} instance Profunctor p => BiInvariant (FromProfunctor p) where biinvmap :: (a' -> a) -> (a -> a') -> (b' -> b) -> (b -> b') -> FromProfunctor p a b -> FromProfunctor p a' b' biinvmap f _ _ g = FromProfunctor . dimap f g . runPro -- | Boilerplate newtype to derive 'BiInvariant' for any 'Bifunctor'. -newtype FromBifunctor p a b = FromBifunctor { runBi :: p a b } +newtype FromBifunctor p a b = FromBifunctor {runBi :: p a b} instance Bifunctor p => BiInvariant (FromBifunctor p) where biinvmap :: (a' -> a) -> (a -> a') -> (b' -> b) -> (b -> b') -> FromBifunctor p a b -> FromBifunctor p a' b' biinvmap _ f _ g = FromBifunctor . bimap f g . runBi -- | Boilerplate newtype to derive 'BiInvariant' for any 'Contravariant'. -newtype FromContra f a = FromContra { runContra :: f a } +newtype FromContra f a = FromContra {runContra :: f a} instance Contravariant f => Contravariant (FromContra f) where contramap :: Contravariant f => (a' -> a) -> FromContra f a -> FromContra f a' contramap f = FromContra . contramap f . runContra newtype FromFunctor f a = FromFunctor (f a) - deriving Functor + deriving (Functor) type Coercible1 f = ((forall a b. Coercible a b => Coercible (f a) (f b)) :: Constraint) + type Coercible2 f = (forall a b c d. (Coercible a b, Coercible c d) => Coercible (f a c) (f b d) :: Constraint) -deriving via (FromProfunctor (->)) instance BiInvariant (->) -deriving via (FromProfunctor (Biff p f g)) instance (Profunctor p, Functor f, Functor g) => BiInvariant (Biff (FromProfunctor p) f g) -deriving via (FromProfunctor (Cayley f q)) instance (Functor f, Profunctor q) => BiInvariant (Cayley f q) -deriving via (FromProfunctor (Closure p)) instance Profunctor p => BiInvariant (Closure p) +deriving via (FromProfunctor (->)) instance BiInvariant (->) + +deriving via (FromProfunctor (Biff p f g)) instance (Profunctor p, Functor f, Functor g) => BiInvariant (Biff (FromProfunctor p) f g) + +deriving via (FromProfunctor (Cayley f q)) instance (Functor f, Profunctor q) => BiInvariant (Cayley f q) + +deriving via (FromProfunctor (Closure p)) instance Profunctor p => BiInvariant (Closure p) + deriving via (FromProfunctor (Clown f :: * -> * -> *)) instance Contravariant f => BiInvariant (Clown (FromContra f) :: * -> * -> *) -deriving via (FromProfunctor (Codensity p)) instance Profunctor p => BiInvariant (Codensity p) -deriving via (FromProfunctor (CofreeMapping p)) instance Profunctor p => BiInvariant (CofreeMapping p) -deriving via (FromProfunctor (CofreeTraversing p)) instance Profunctor p => BiInvariant (CofreeTraversing p) -deriving via (FromProfunctor (Cokleisli w)) instance Functor w => BiInvariant (Cokleisli w) -deriving via (FromProfunctor (Copastro p)) instance BiInvariant (Copastro p) -deriving via (FromProfunctor (CopastroSum p)) instance BiInvariant (CopastroSum p) -deriving via (FromProfunctor (Costar f)) instance Functor f => BiInvariant (Costar f) -deriving via (FromProfunctor (Cotambara p)) instance BiInvariant (Cotambara p) -deriving via (FromProfunctor (CotambaraSum p)) instance BiInvariant (CotambaraSum p) -deriving via (FromProfunctor (Coyoneda p)) instance BiInvariant (Coyoneda p) -deriving via (FromProfunctor (Environment p)) instance BiInvariant (Environment p) + +deriving via (FromProfunctor (Codensity p)) instance Profunctor p => BiInvariant (Codensity p) + +deriving via (FromProfunctor (CofreeMapping p)) instance Profunctor p => BiInvariant (CofreeMapping p) + +deriving via (FromProfunctor (CofreeTraversing p)) instance Profunctor p => BiInvariant (CofreeTraversing p) + +deriving via (FromProfunctor (Cokleisli w)) instance Functor w => BiInvariant (Cokleisli w) + +deriving via (FromProfunctor (Copastro p)) instance BiInvariant (Copastro p) + +deriving via (FromProfunctor (CopastroSum p)) instance BiInvariant (CopastroSum p) + +deriving via (FromProfunctor (Costar f)) instance Functor f => BiInvariant (Costar f) + +deriving via (FromProfunctor (Cotambara p)) instance BiInvariant (Cotambara p) + +deriving via (FromProfunctor (CotambaraSum p)) instance BiInvariant (CotambaraSum p) + +deriving via (FromProfunctor (Coyoneda p)) instance BiInvariant (Coyoneda p) + +deriving via (FromProfunctor (Environment p)) instance BiInvariant (Environment p) + deriving via (FromProfunctor (Forget r :: * -> * -> *)) instance BiInvariant (Forget r :: * -> * -> *) -deriving via (FromProfunctor (FreeMapping p)) instance BiInvariant (FreeMapping p) -deriving via (FromProfunctor (FreeTraversing p)) instance BiInvariant (FreeTraversing p) -deriving via (FromProfunctor (Joker f :: * -> * -> *)) instance Functor f => BiInvariant (Joker (FromContra f) :: * -> * -> *) -deriving via (FromProfunctor (Kleisli m)) instance Monad m => BiInvariant (Kleisli m) -deriving via (FromProfunctor (Pastro p)) instance BiInvariant (Pastro p) -deriving via (FromProfunctor (PastroSum p)) instance BiInvariant (PastroSum p) -deriving via (FromProfunctor (Procompose p q)) instance (Profunctor p, Profunctor q) => BiInvariant (Procompose p q) -deriving via (FromProfunctor (Product p q)) instance (Profunctor p, Profunctor q) => BiInvariant (Product (FromProfunctor p) (FromProfunctor q)) -deriving via (FromProfunctor (Ran p q)) instance (Profunctor p, Profunctor q) => BiInvariant (Ran p q) -deriving via (FromProfunctor (Rift p q)) instance (Profunctor p, Profunctor q) => BiInvariant (Rift p q) -deriving via (FromProfunctor (Star f)) instance Functor f => BiInvariant (Star (FromFunctor f)) -deriving via (FromProfunctor (Sum p q)) instance (Profunctor p, Profunctor q) => BiInvariant (Sum (FromProfunctor p) (FromProfunctor q)) + +deriving via (FromProfunctor (FreeMapping p)) instance BiInvariant (FreeMapping p) + +deriving via (FromProfunctor (FreeTraversing p)) instance BiInvariant (FreeTraversing p) + +deriving via (FromProfunctor (Joker f :: * -> * -> *)) instance Functor f => BiInvariant (Joker (FromContra f) :: * -> * -> *) + +deriving via (FromProfunctor (Kleisli m)) instance Monad m => BiInvariant (Kleisli m) + +deriving via (FromProfunctor (Pastro p)) instance BiInvariant (Pastro p) + +deriving via (FromProfunctor (PastroSum p)) instance BiInvariant (PastroSum p) + +deriving via (FromProfunctor (Procompose p q)) instance (Profunctor p, Profunctor q) => BiInvariant (Procompose p q) + +deriving via (FromProfunctor (Product p q)) instance (Profunctor p, Profunctor q) => BiInvariant (Product (FromProfunctor p) (FromProfunctor q)) + +deriving via (FromProfunctor (Ran p q)) instance (Profunctor p, Profunctor q) => BiInvariant (Ran p q) + +deriving via (FromProfunctor (Rift p q)) instance (Profunctor p, Profunctor q) => BiInvariant (Rift p q) + +deriving via (FromProfunctor (Star f)) instance Functor f => BiInvariant (Star (FromFunctor f)) + +deriving via (FromProfunctor (Star f)) instance Functor f => BiInvariant (Star (FromContra f)) + +deriving via (FromProfunctor (Sum p q)) instance (Profunctor p, Profunctor q) => BiInvariant (Sum (FromProfunctor p) (FromProfunctor q)) + deriving via (FromProfunctor (Tagged :: * -> * -> *)) instance BiInvariant (Tagged :: * -> * -> *) -deriving via (FromProfunctor (Tambara p)) instance Profunctor p => BiInvariant (Tambara p) -deriving via (FromProfunctor (TambaraSum p)) instance Profunctor p => BiInvariant (TambaraSum p) -deriving via (FromProfunctor (Tannen f q)) instance (Functor f, Profunctor q) => BiInvariant (Tannen f q) -deriving via (FromProfunctor (WrappedArrow p)) instance Arrow p => BiInvariant (WrappedArrow p) -deriving via (FromProfunctor (Yoneda p)) instance BiInvariant (Yoneda p) -deriving via (FromBifunctor ((,,) x1)) instance BiInvariant ((,,) x1) -deriving via (FromBifunctor ((,,,) x1 x2)) instance BiInvariant ((,,,) x1 x2) -deriving via (FromBifunctor ((,,,,) x1 x2 x3)) instance BiInvariant ((,,,,) x1 x2 x3) -deriving via (FromBifunctor ((,,,,,) x1 x2 x3 x4)) instance BiInvariant ((,,,,,) x1 x2 x3 x4) +deriving via (FromProfunctor (Tambara p)) instance Profunctor p => BiInvariant (Tambara p) + +deriving via (FromProfunctor (TambaraSum p)) instance Profunctor p => BiInvariant (TambaraSum p) + +deriving via (FromProfunctor (Tannen f q)) instance (Functor f, Profunctor q) => BiInvariant (Tannen f q) + +deriving via (FromProfunctor (WrappedArrow p)) instance Arrow p => BiInvariant (WrappedArrow p) + +deriving via (FromProfunctor (Yoneda p)) instance BiInvariant (Yoneda p) + +deriving via (FromBifunctor ((,,) x1)) instance BiInvariant ((,,) x1) + +deriving via (FromBifunctor ((,,,) x1 x2)) instance BiInvariant ((,,,) x1 x2) + +deriving via (FromBifunctor ((,,,,) x1 x2 x3)) instance BiInvariant ((,,,,) x1 x2 x3) + +deriving via (FromBifunctor ((,,,,,) x1 x2 x3 x4)) instance BiInvariant ((,,,,,) x1 x2 x3 x4) + deriving via (FromBifunctor ((,,,,,,) x1 x2 x3 x4 x5)) instance BiInvariant ((,,,,,,) x1 x2 x3 x4 x5) -deriving via (FromBifunctor (,)) instance BiInvariant (,) -deriving via (FromBifunctor Arg) instance BiInvariant Arg -deriving via (FromBifunctor (Biap bi)) instance Bifunctor bi => BiInvariant (Biap bi) -deriving via (FromBifunctor (Biff p f g)) instance (Bifunctor p, Functor f, Functor g) => BiInvariant (Biff (FromBifunctor p) f g) -deriving via (FromBifunctor (Clown f :: * -> * -> *)) instance Functor f => BiInvariant (Clown (FromFunctor f) :: * -> * -> *) -deriving via (FromBifunctor (Const :: * -> * -> *)) instance BiInvariant (Const :: * -> * -> *) -deriving via (FromBifunctor Either) instance BiInvariant Either -deriving via (FromBifunctor (Flip p)) instance Bifunctor p => BiInvariant (Flip p) -deriving via (FromBifunctor (Joker f :: * -> * -> *)) instance Functor f => BiInvariant (Joker (FromFunctor f) :: * -> * -> *) -deriving via (FromBifunctor (K1 i :: * -> * -> *)) instance BiInvariant (K1 i :: * -> * -> *) -deriving via (FromBifunctor (Product p q)) instance (Bifunctor p, Bifunctor q) => BiInvariant (Product (FromBifunctor p) (FromBifunctor q)) -deriving via (FromBifunctor (Sum p q)) instance (Bifunctor p, Bifunctor q) => BiInvariant (Sum (FromBifunctor p) (FromBifunctor q)) -deriving via (FromBifunctor (Tannen f q)) instance (Functor f, Coercible1 f, Bifunctor q) => BiInvariant (Tannen (FromFunctor f) (FromBifunctor q)) -deriving via (FromBifunctor These) instance BiInvariant These -deriving via (FromBifunctor (WrappedBifunctor p)) instance Bifunctor p => BiInvariant (WrappedBifunctor p) + +deriving via (FromBifunctor (,)) instance BiInvariant (,) + +deriving via (FromBifunctor Arg) instance BiInvariant Arg + +deriving via (FromBifunctor (Biap bi)) instance Bifunctor bi => BiInvariant (Biap bi) + +deriving via (FromBifunctor (Biff p f g)) instance (Bifunctor p, Functor f, Functor g) => BiInvariant (Biff (FromBifunctor p) f g) + +deriving via (FromBifunctor (Clown f :: * -> * -> *)) instance Functor f => BiInvariant (Clown (FromFunctor f) :: * -> * -> *) + +deriving via (FromBifunctor (Const :: * -> * -> *)) instance BiInvariant (Const :: * -> * -> *) + +deriving via (FromBifunctor Either) instance BiInvariant Either + +deriving via (FromBifunctor (Flip p)) instance Bifunctor p => BiInvariant (Flip p) + +deriving via (FromBifunctor (Joker f :: * -> * -> *)) instance Functor f => BiInvariant (Joker (FromFunctor f) :: * -> * -> *) + +deriving via (FromBifunctor (K1 i :: * -> * -> *)) instance BiInvariant (K1 i :: * -> * -> *) + +deriving via (FromBifunctor (Product p q)) instance (Bifunctor p, Bifunctor q) => BiInvariant (Product (FromBifunctor p) (FromBifunctor q)) + +deriving via (FromBifunctor (Sum p q)) instance (Bifunctor p, Bifunctor q) => BiInvariant (Sum (FromBifunctor p) (FromBifunctor q)) + +deriving via (FromBifunctor (Tannen f q)) instance (Functor f, Coercible1 f, Bifunctor q) => BiInvariant (Tannen (FromFunctor f) (FromBifunctor q)) + +deriving via (FromBifunctor These) instance BiInvariant These + +deriving via (FromBifunctor (WrappedBifunctor p)) instance Bifunctor p => BiInvariant (WrappedBifunctor p) diff --git a/src/Data/Bifunctor/Module.hs b/src/Data/Bifunctor/Module.hs --- a/src/Data/Bifunctor/Module.hs +++ b/src/Data/Bifunctor/Module.hs @@ -50,675 +50,1055 @@ import Data.Profunctor.Yoneda (Coyoneda, Yoneda) import Data.Semigroup (Arg) import Data.Tagged (Tagged) -import Data.These (These (This, That)) -import Data.Traversable (Traversable) -import Data.Tuple (fst, snd) -import GHC.Generics (K1 (..)) - --------------------------------------------------------------------------------- - --- | Boilerplate newtype to derive modules for any 'Profunctor'. -newtype FromProfunctor p a b = FromProfunctor (p a b) - deriving newtype (Functor, Profunctor, Strong, Choice, Costrong, Cochoice) - --- | Boilerplate newtype to derive modules for any 'Bifunctor'. -newtype FromBifunctor p a b = FromBifunctor (p a b) - deriving newtype (Functor, Bifunctor) - --------------------------------------------------------------------------------- - --- | A 'Profunctor' \(P : \mathcal{C}^{op} \times \mathcal{D} \to Set\) --- is a Tambara 'LeftModule' if it is equipped with a morphism \(s_{a,b,m} : P(a, b) \to P(a \odot m, b \odot m)\), --- which we call 'lstrength'. --- --- === Laws --- --- @ --- 'Types.lmap' 'Control.Category.Cartesian.projl' ≡ 'Types.rmap' 'Control.Category.Cartesian.projl' 'Control.Category..' 'lstrength' --- 'Data.Profunctor.Types.lmap' ('rstrength' @f@) 'Control.Category..' 'lstrength' ≡ 'Data.Profunctor.Types.rmap' ('rstrength' @f@) 'Control.Category..' 'lstrength' --- 'lstrength' 'Control.Category..' 'lstrength' ≡ 'Types.dimap' ('Control.Category.Tensor.bwd' 'Control.Category.Tensor.assoc') ('Control.Category.Tensor.fwd' 'Control.Category.Tensor.assoc') 'Control.Category..' 'lstrength' --- @ -class LeftModule cat t1 t2 p where - -- | ==== __Examples__ - -- - -- 'Data.Profiunctor.Strong.first'': - -- - -- >>> :t lstrength @(->) @(,) @(,) - -- lstrength @(->) @(,) @(,) :: LeftModule (->) (,) (,) p => p a b -> p (a, x) (b, x) - -- - -- 'Data.Profiunctor.Choice.left'': - -- - -- >>> :t lstrength @(->) @Either @Either - -- lstrength @(->) @Either @Either :: LeftModule (->) Either Either p => p a b -> p (Either a x) (Either b x) - lstrength :: cat (p a b) (p (t1 a x) (t2 b x)) - -instance Strong p => LeftModule (->) (,) (,) (FromProfunctor p) where - lstrength :: FromProfunctor p a b -> FromProfunctor p (a, x) (b, x) - lstrength = first' - -instance Choice p => LeftModule (->) Either Either (FromProfunctor p) where - lstrength :: FromProfunctor p a b -> FromProfunctor p (Either a x) (Either b x) - lstrength = left' - -instance Bifunctor p => LeftModule (->) Either Either (FromBifunctor p) where - lstrength :: FromBifunctor p a b -> FromBifunctor p (Either a x) (Either b x) - lstrength = gbimap Left Left - -instance Bifunctor p => LeftModule (->) These These (FromBifunctor p) where - lstrength :: FromBifunctor p a b -> FromBifunctor p (These a x) (These b x) - lstrength = gbimap This This - -instance Bifunctor p => LeftModule Op (,) (,) (FromBifunctor p) where - lstrength :: Op (FromBifunctor p a b) (FromBifunctor p (a, x) (b, x)) - lstrength = Op (gbimap fst fst) - -deriving via (FromProfunctor (Kleisli m)) instance Monad m => LeftModule (->) (,) (,) (Kleisli m) -deriving via (FromProfunctor (Pastro p)) instance LeftModule (->) (,) (,) (Pastro p) -deriving via (FromProfunctor (Tambara p)) instance Profunctor p => LeftModule (->) (,) (,) (Tambara p) -deriving via (FromProfunctor (Closure p)) instance Strong p => LeftModule (->) (,) (,) (Closure p) -deriving via (FromProfunctor (FreeTraversing p)) instance LeftModule (->) (,) (,) (FreeTraversing p) -deriving via (FromProfunctor (CofreeTraversing p)) instance Profunctor p => LeftModule (->) (,) (,) (CofreeTraversing p) -deriving via (FromProfunctor (FreeMapping p)) instance LeftModule (->) (,) (,) (FreeMapping p) -deriving via (FromProfunctor (CofreeMapping p)) instance Profunctor p => LeftModule (->) (,) (,) (CofreeMapping p) -deriving via (FromProfunctor (Coyoneda p)) instance Strong p => LeftModule (->) (,) (,) (Coyoneda p) -deriving via (FromProfunctor (Yoneda p)) instance Strong p => LeftModule (->) (,) (,) (Yoneda p) -deriving via (FromProfunctor (->)) instance LeftModule (->) (,) (,) (->) -deriving via (FromProfunctor (Forget r)) instance LeftModule (->) (,) (,) (Forget r) -deriving via (FromProfunctor (Star m)) instance Functor m => LeftModule (->) (,) (,) (Star m) -deriving via (FromProfunctor (Clown f)) instance Contravariant f => LeftModule (->) (,) (,) (Clown f) -deriving via (FromProfunctor (WrappedArrow p)) instance Arrow p => LeftModule (->) (,) (,) (WrappedArrow p) -deriving via (FromProfunctor (Sum p q)) instance (Strong p, Strong q) => LeftModule (->) (,) (,) (Sum p q) -deriving via (FromProfunctor (Product p q)) instance (Strong p, Strong q) => LeftModule (->) (,) (,) (Product p q) -deriving via (FromProfunctor (Tannen f q)) instance (Functor f, Strong q) => LeftModule (->) (,) (,) (Tannen f q) -deriving via (FromProfunctor (Procompose p q)) instance (Strong p, Strong q) => LeftModule (->) (,) (,) (Procompose p q) -deriving via (FromProfunctor (Cayley f q)) instance (Functor f, Strong q) => LeftModule (->) (,) (,) (Cayley f q) - -deriving via (FromProfunctor (Kleisli m)) instance Monad m => LeftModule (->) Either Either (Kleisli m) -deriving via (FromProfunctor Tagged) instance LeftModule (->) Either Either Tagged -deriving via (FromProfunctor (Tambara p)) instance (Choice p) => LeftModule (->) Either Either (Tambara p) -deriving via (FromProfunctor (PastroSum p)) instance LeftModule (->) Either Either (PastroSum p) -deriving via (FromProfunctor (TambaraSum p)) instance Profunctor p => LeftModule (->) Either Either (TambaraSum p) -deriving via (FromProfunctor (FreeTraversing p)) instance LeftModule (->) Either Either ( FreeTraversing p) -deriving via (FromProfunctor (CofreeTraversing p)) instance Profunctor p => LeftModule (->) Either Either (CofreeTraversing p) -deriving via (FromProfunctor (FreeMapping p )) instance LeftModule (->) Either Either (FreeMapping p) -deriving via (FromProfunctor (CofreeMapping p)) instance Profunctor p => LeftModule (->) Either Either (CofreeMapping p) -deriving via (FromProfunctor (Coyoneda p)) instance Choice p => LeftModule (->) Either Either (Coyoneda p) -deriving via (FromProfunctor (Yoneda p)) instance Choice p => LeftModule (->) Either Either (Yoneda p) -deriving via (FromProfunctor (->)) instance LeftModule (->) Either Either (->) -deriving via (FromProfunctor (Cokleisli w)) instance Comonad w => LeftModule (->) Either Either (Cokleisli w) -deriving via (FromProfunctor (Forget r)) instance Monoid r => LeftModule (->) Either Either (Forget r) -deriving via (FromProfunctor (Star f)) instance Applicative f => LeftModule (->) Either Either (Star f) -deriving via (FromProfunctor (Joker f)) instance Functor f => LeftModule (->) Either Either (Joker f) -deriving via (FromProfunctor (WrappedArrow p)) instance ArrowChoice p => LeftModule (->) Either Either (WrappedArrow p) -deriving via (FromProfunctor (Sum p q)) instance (Choice p, Choice q) => LeftModule (->) Either Either (Sum p q) -deriving via (FromProfunctor (Product p q)) instance (Choice p, Choice q) => LeftModule (->) Either Either (Product p q) -deriving via (FromProfunctor (Tannen f p)) instance (Functor f, Choice p) => LeftModule (->) Either Either (Tannen f p) -deriving via (FromProfunctor (Procompose p q)) instance (Choice p, Choice q) => LeftModule (->) Either Either (Procompose p q) -deriving via (FromProfunctor (Cayley f q)) instance (Functor f, Choice q) => LeftModule (->) Either Either (Cayley f q) - -deriving via (FromBifunctor Arg) instance LeftModule (->) Either Either Arg -deriving via (FromBifunctor Const) instance LeftModule (->) Either Either Const -deriving via (FromBifunctor Either) instance LeftModule (->) Either Either Either -deriving via (FromBifunctor These) instance LeftModule (->) Either Either These -deriving via (FromBifunctor (K1 i)) instance LeftModule (->) Either Either (K1 i :: Type -> Type -> Type) -deriving via (FromBifunctor (,)) instance LeftModule (->) Either Either (,) -deriving via (FromBifunctor ((,,) x1)) instance LeftModule (->) Either Either ((,,) x1) -deriving via (FromBifunctor ((,,,) x1 x2)) instance LeftModule (->) Either Either ((,,,) x1 x2) -deriving via (FromBifunctor ((,,,,) x1 x2 x3)) instance LeftModule (->) Either Either ((,,,,) x1 x2 x3) -deriving via (FromBifunctor ((,,,,,) x1 x2 x3 x4)) instance LeftModule (->) Either Either ((,,,,,) x1 x2 x3 x4) -deriving via (FromBifunctor ((,,,,,,) x1 x2 x3 x4 x5)) instance LeftModule (->) Either Either ((,,,,,,) x1 x2 x3 x4 x5) - -deriving via (FromBifunctor Arg) instance LeftModule (->) These These Arg -deriving via (FromBifunctor Const) instance LeftModule (->) These These Const -deriving via (FromBifunctor Either) instance LeftModule (->) These These Either -deriving via (FromBifunctor These) instance LeftModule (->) These These These -deriving via (FromBifunctor (K1 i)) instance LeftModule (->) These These (K1 i :: Type -> Type -> Type) -deriving via (FromBifunctor (,)) instance LeftModule (->) These These (,) -deriving via (FromBifunctor ((,,) x1)) instance LeftModule (->) These These ((,,) x1) -deriving via (FromBifunctor ((,,,) x1 x2)) instance LeftModule (->) These These ((,,,) x1 x2) -deriving via (FromBifunctor ((,,,,) x1 x2 x3)) instance LeftModule (->) These These ((,,,,) x1 x2 x3) -deriving via (FromBifunctor ((,,,,,) x1 x2 x3 x4)) instance LeftModule (->) These These ((,,,,,) x1 x2 x3 x4) -deriving via (FromBifunctor ((,,,,,,) x1 x2 x3 x4 x5)) instance LeftModule (->) These These ((,,,,,,) x1 x2 x3 x4 x5) - -deriving via (FromBifunctor Arg) instance LeftModule Op (,) (,) Arg -deriving via (FromBifunctor Const) instance LeftModule Op (,) (,) Const -deriving via (FromBifunctor Either) instance LeftModule Op (,) (,) Either -deriving via (FromBifunctor These) instance LeftModule Op (,) (,) These -deriving via (FromBifunctor (K1 i)) instance LeftModule Op (,) (,) (K1 i :: Type -> Type -> Type) -deriving via (FromBifunctor (,)) instance LeftModule Op (,) (,) (,) -deriving via (FromBifunctor ((,,) x1)) instance LeftModule Op (,) (,) ((,,) x1) -deriving via (FromBifunctor ((,,,) x1 x2)) instance LeftModule Op (,) (,) ((,,,) x1 x2) -deriving via (FromBifunctor ((,,,,) x1 x2 x3)) instance LeftModule Op (,) (,) ((,,,,) x1 x2 x3) -deriving via (FromBifunctor ((,,,,,) x1 x2 x3 x4)) instance LeftModule Op (,) (,) ((,,,,,) x1 x2 x3 x4) -deriving via (FromBifunctor ((,,,,,,) x1 x2 x3 x4 x5)) instance LeftModule Op (,) (,) ((,,,,,,) x1 x2 x3 x4 x5) - --------------------------------------------------------------------------------- - --- | A 'Profunctor' \(P : \mathcal{C}^{op} \times \mathcal{D} \to Set\) --- is a Tambara 'RightModule' if it is equipped with a morphism \(s_{a,b,m} : P(a, b) \to P(m \odot a, m \odot b)\), --- which we call 'rstrength'. --- --- === Laws --- --- @ --- 'Data.Profunctor.Types.lmap' 'Control.Category.Cartesian.projr' ≡ 'Data.Profunctor.Types.rmap' 'Control.Category.Cartesian.projr' 'Control.Category..' 'rstrength' --- 'Data.Profunctor.Types.lmap' ('lstrength' @f@) 'Control.Category..' 'rstrength' ≡ 'Data.Profunctor.Types.rmap' ('lstrength' @f@) 'Control.Category..' 'rstrength' --- 'rstrength' 'Control.Category..' 'rstrength' ≡ 'Data.Profunctor.Types.dimap' ('Control.Category.Tensor.fwd' 'Control.Category.Tensor.assoc') ('Control.Category.Tensor.bwd' 'Control.Category.Tensor.assoc') 'Control.Category..' 'rstrength' --- @ -class RightModule cat t1 t2 f where - -- | ==== __Examples__ - -- - -- 'Data.Profunctor.Strong.second'': - -- - -- >>> :t rstrength @(->) @(,) @(,) - -- rstrength @(->) @(,) @(,) :: RightModule (->) (,) (,) f => f a b -> f (x, a) (x, b) - -- - -- 'Data.Profunctor.Choice.right'': - -- - -- >>> :t rstrength @(->) @Either @Either - -- rstrength @(->) @Either @Either :: RightModule (->) Either Either f => f a b -> f (Either x a) (Either x b) - rstrength :: cat (f a b) (f (x `t1` a) (x `t2` b)) - -instance Strong p => RightModule (->) (,) (,) (FromProfunctor p) where - rstrength :: FromProfunctor p a b -> FromProfunctor p (c, a) (c, b) - rstrength = second' - -instance Choice p => RightModule (->) Either Either (FromProfunctor p) where - rstrength :: FromProfunctor p a b -> FromProfunctor p (Either c a) (Either c b) - rstrength = right' - -instance Bifunctor p => RightModule (->) Either Either (FromBifunctor p) where - rstrength :: FromBifunctor p a b -> FromBifunctor p (Either x a) (Either x b) - rstrength = gbimap Right Right - -instance Bifunctor p => RightModule (->) These These (FromBifunctor p) where - rstrength :: FromBifunctor p a b -> FromBifunctor p (These x a) (These x b) - rstrength = gbimap That That - -instance Bifunctor p => RightModule Op (,) (,) (FromBifunctor p) where - rstrength :: Op (FromBifunctor p a b) (FromBifunctor p (x, a) (x, b)) - rstrength = Op (gbimap snd snd) - -deriving via (FromProfunctor (Kleisli m)) instance Monad m => RightModule (->) (,) (,) (Kleisli m) -deriving via (FromProfunctor (Pastro p)) instance RightModule (->) (,) (,) (Pastro p) -deriving via (FromProfunctor (Tambara p)) instance Profunctor p => RightModule (->) (,) (,) (Tambara p) -deriving via (FromProfunctor (Closure p)) instance Strong p => RightModule (->) (,) (,) (Closure p) -deriving via (FromProfunctor (FreeTraversing p)) instance RightModule (->) (,) (,) (FreeTraversing p) -deriving via (FromProfunctor (CofreeTraversing p)) instance Profunctor p => RightModule (->) (,) (,) (CofreeTraversing p) -deriving via (FromProfunctor (FreeMapping p)) instance RightModule (->) (,) (,) (FreeMapping p) -deriving via (FromProfunctor (CofreeMapping p)) instance Profunctor p => RightModule (->) (,) (,) (CofreeMapping p) -deriving via (FromProfunctor (Coyoneda p)) instance Strong p => RightModule (->) (,) (,) (Coyoneda p) -deriving via (FromProfunctor (Yoneda p)) instance Strong p => RightModule (->) (,) (,) (Yoneda p) -deriving via (FromProfunctor (->)) instance RightModule (->) (,) (,) (->) -deriving via (FromProfunctor (Forget r)) instance RightModule (->) (,) (,) (Forget r) -deriving via (FromProfunctor (Star m)) instance Functor m => RightModule (->) (,) (,) (Star m) -deriving via (FromProfunctor (Clown f)) instance Contravariant f => RightModule (->) (,) (,) (Clown f) -deriving via (FromProfunctor (WrappedArrow p)) instance Arrow p => RightModule (->) (,) (,) (WrappedArrow p) -deriving via (FromProfunctor (Sum p q)) instance (Strong p, Strong q) => RightModule (->) (,) (,) (Sum p q) -deriving via (FromProfunctor (Product p q)) instance (Strong p, Strong q) => RightModule (->) (,) (,) (Product p q) -deriving via (FromProfunctor (Tannen f q)) instance (Functor f, Strong q) => RightModule (->) (,) (,) (Tannen f q) -deriving via (FromProfunctor (Procompose p q)) instance (Strong p, Strong q) => RightModule (->) (,) (,) (Procompose p q) -deriving via (FromProfunctor (Cayley f q)) instance (Functor f, Strong q) => RightModule (->) (,) (,) (Cayley f q) - -deriving via (FromProfunctor (Kleisli m)) instance Monad m => RightModule (->) Either Either (Kleisli m) -deriving via (FromProfunctor Tagged) instance RightModule (->) Either Either Tagged -deriving via (FromProfunctor (Tambara p)) instance (Choice p) => RightModule (->) Either Either (Tambara p) -deriving via (FromProfunctor (PastroSum p)) instance RightModule (->) Either Either (PastroSum p) -deriving via (FromProfunctor (TambaraSum p)) instance Profunctor p => RightModule (->) Either Either (TambaraSum p) -deriving via (FromProfunctor (FreeTraversing p)) instance RightModule (->) Either Either ( FreeTraversing p) -deriving via (FromProfunctor (CofreeTraversing p)) instance Profunctor p => RightModule (->) Either Either (CofreeTraversing p) -deriving via (FromProfunctor (FreeMapping p )) instance RightModule (->) Either Either (FreeMapping p) -deriving via (FromProfunctor (CofreeMapping p)) instance Profunctor p => RightModule (->) Either Either (CofreeMapping p) -deriving via (FromProfunctor (Coyoneda p)) instance Choice p => RightModule (->) Either Either (Coyoneda p) -deriving via (FromProfunctor (Yoneda p)) instance Choice p => RightModule (->) Either Either (Yoneda p) -deriving via (FromProfunctor (->)) instance RightModule (->) Either Either (->) -deriving via (FromProfunctor (Cokleisli w)) instance Comonad w => RightModule (->) Either Either (Cokleisli w) -deriving via (FromProfunctor (Forget r)) instance Monoid r => RightModule (->) Either Either (Forget r) -deriving via (FromProfunctor (Star f)) instance Applicative f => RightModule (->) Either Either (Star f) -deriving via (FromProfunctor (Joker f)) instance Functor f => RightModule (->) Either Either (Joker f) -deriving via (FromProfunctor (WrappedArrow p)) instance ArrowChoice p => RightModule (->) Either Either (WrappedArrow p) -deriving via (FromProfunctor (Sum p q)) instance (Choice p, Choice q) => RightModule (->) Either Either (Sum p q) -deriving via (FromProfunctor (Product p q)) instance (Choice p, Choice q) => RightModule (->) Either Either (Product p q) -deriving via (FromProfunctor (Tannen f p)) instance (Functor f, Choice p) => RightModule (->) Either Either (Tannen f p) -deriving via (FromProfunctor (Procompose p q)) instance (Choice p, Choice q) => RightModule (->) Either Either (Procompose p q) -deriving via (FromProfunctor (Cayley f q)) instance (Functor f, Choice q) => RightModule (->) Either Either (Cayley f q) - -deriving via (FromBifunctor Arg) instance RightModule (->) Either Either Arg -deriving via (FromBifunctor Const) instance RightModule (->) Either Either Const -deriving via (FromBifunctor Either) instance RightModule (->) Either Either Either -deriving via (FromBifunctor These) instance RightModule (->) Either Either These -deriving via (FromBifunctor (K1 i)) instance RightModule (->) Either Either (K1 i :: Type -> Type -> Type) -deriving via (FromBifunctor (,)) instance RightModule (->) Either Either (,) -deriving via (FromBifunctor ((,,) x1)) instance RightModule (->) Either Either ((,,) x1) -deriving via (FromBifunctor ((,,,) x1 x2)) instance RightModule (->) Either Either ((,,,) x1 x2) -deriving via (FromBifunctor ((,,,,) x1 x2 x3)) instance RightModule (->) Either Either ((,,,,) x1 x2 x3) -deriving via (FromBifunctor ((,,,,,) x1 x2 x3 x4)) instance RightModule (->) Either Either ((,,,,,) x1 x2 x3 x4) -deriving via (FromBifunctor ((,,,,,,) x1 x2 x3 x4 x5)) instance RightModule (->) Either Either ((,,,,,,) x1 x2 x3 x4 x5) - -deriving via (FromBifunctor Arg) instance RightModule (->) These These Arg -deriving via (FromBifunctor Const) instance RightModule (->) These These Const -deriving via (FromBifunctor Either) instance RightModule (->) These These Either -deriving via (FromBifunctor These) instance RightModule (->) These These These -deriving via (FromBifunctor (K1 i)) instance RightModule (->) These These (K1 i :: Type -> Type -> Type) -deriving via (FromBifunctor (,)) instance RightModule (->) These These (,) -deriving via (FromBifunctor ((,,) x1)) instance RightModule (->) These These ((,,) x1) -deriving via (FromBifunctor ((,,,) x1 x2)) instance RightModule (->) These These ((,,,) x1 x2) -deriving via (FromBifunctor ((,,,,) x1 x2 x3)) instance RightModule (->) These These ((,,,,) x1 x2 x3) -deriving via (FromBifunctor ((,,,,,) x1 x2 x3 x4)) instance RightModule (->) These These ((,,,,,) x1 x2 x3 x4) -deriving via (FromBifunctor ((,,,,,,) x1 x2 x3 x4 x5)) instance RightModule (->) These These ((,,,,,,) x1 x2 x3 x4 x5) - -deriving via (FromBifunctor Arg) instance RightModule Op (,) (,) Arg -deriving via (FromBifunctor Const) instance RightModule Op (,) (,) Const -deriving via (FromBifunctor Either) instance RightModule Op (,) (,) Either -deriving via (FromBifunctor These) instance RightModule Op (,) (,) These -deriving via (FromBifunctor (K1 i)) instance RightModule Op (,) (,) (K1 i :: Type -> Type -> Type) -deriving via (FromBifunctor (,)) instance RightModule Op (,) (,) (,) -deriving via (FromBifunctor ((,,) x1)) instance RightModule Op (,) (,) ((,,) x1) -deriving via (FromBifunctor ((,,,) x1 x2)) instance RightModule Op (,) (,) ((,,,) x1 x2) -deriving via (FromBifunctor ((,,,,) x1 x2 x3)) instance RightModule Op (,) (,) ((,,,,) x1 x2 x3) -deriving via (FromBifunctor ((,,,,,) x1 x2 x3 x4)) instance RightModule Op (,) (,) ((,,,,,) x1 x2 x3 x4) -deriving via (FromBifunctor ((,,,,,,) x1 x2 x3 x4 x5)) instance RightModule Op (,) (,) ((,,,,,,) x1 x2 x3 x4 x5) - --------------------------------------------------------------------------------- - --- | A 'Profunctor' equipped with both a Tambara 'LeftModule' and --- Tambara 'RightModule' is a 'Bimodule'. --- --- === Laws --- --- @ --- 'rstrength' ≡ 'Data.Profunctor.Types.dimap' 'Control.Category.Tensor.swap' 'Control.Category.Tensor.swap' 'Control.Category..' 'lstrength' --- 'lstrength' ≡ 'Data.Profunctor.Types.dimap' 'Control.Category.Tensor.swap' 'Control.Category.Tensor.swap' 'Control.Category..' 'rstrength' --- @ -class (LeftModule cat t1 t2 f, RightModule cat t1 t2 f) => Bimodule cat t1 t2 f - -instance Strong p => Bimodule (->) (,) (,) (FromProfunctor p) -instance Choice p => Bimodule (->) Either Either (FromProfunctor p) -instance Bifunctor p => Bimodule (->) Either Either (FromBifunctor p) -instance Bifunctor p => Bimodule (->) These These (FromBifunctor p) -instance Bifunctor p => Bimodule Op (,) (,) (FromBifunctor p) - -deriving via (FromProfunctor (Kleisli m)) instance Monad m => Bimodule (->) (,) (,) (Kleisli m) -deriving via (FromProfunctor (Pastro p)) instance Bimodule (->) (,) (,) (Pastro p) -deriving via (FromProfunctor (Tambara p)) instance Profunctor p => Bimodule (->) (,) (,) (Tambara p) -deriving via (FromProfunctor (Closure p)) instance Strong p => Bimodule (->) (,) (,) (Closure p) -deriving via (FromProfunctor (FreeTraversing p)) instance Bimodule (->) (,) (,) (FreeTraversing p) -deriving via (FromProfunctor (CofreeTraversing p)) instance Profunctor p => Bimodule (->) (,) (,) (CofreeTraversing p) -deriving via (FromProfunctor (FreeMapping p)) instance Bimodule (->) (,) (,) (FreeMapping p) -deriving via (FromProfunctor (CofreeMapping p)) instance Profunctor p => Bimodule (->) (,) (,) (CofreeMapping p) -deriving via (FromProfunctor (Coyoneda p)) instance Strong p => Bimodule (->) (,) (,) (Coyoneda p) -deriving via (FromProfunctor (Yoneda p)) instance Strong p => Bimodule (->) (,) (,) (Yoneda p) -deriving via (FromProfunctor (->)) instance Bimodule (->) (,) (,) (->) -deriving via (FromProfunctor (Forget r)) instance Bimodule (->) (,) (,) (Forget r) -deriving via (FromProfunctor (Star m)) instance Functor m => Bimodule (->) (,) (,) (Star m) -deriving via (FromProfunctor (Clown f)) instance Contravariant f => Bimodule (->) (,) (,) (Clown f) -deriving via (FromProfunctor (WrappedArrow p)) instance Arrow p => Bimodule (->) (,) (,) (WrappedArrow p) -deriving via (FromProfunctor (Sum p q)) instance (Strong p, Strong q) => Bimodule (->) (,) (,) (Sum p q) -deriving via (FromProfunctor (Product p q)) instance (Strong p, Strong q) => Bimodule (->) (,) (,) (Product p q) -deriving via (FromProfunctor (Tannen f q)) instance (Functor f, Strong q) => Bimodule (->) (,) (,) (Tannen f q) -deriving via (FromProfunctor (Procompose p q)) instance (Strong p, Strong q) => Bimodule (->) (,) (,) (Procompose p q) -deriving via (FromProfunctor (Cayley f q)) instance (Functor f, Strong q) => Bimodule (->) (,) (,) (Cayley f q) - -deriving via (FromProfunctor (Kleisli m)) instance Monad m => Bimodule (->) Either Either (Kleisli m) -deriving via (FromProfunctor Tagged) instance Bimodule (->) Either Either Tagged -deriving via (FromProfunctor (Tambara p)) instance (Choice p) => Bimodule (->) Either Either (Tambara p) -deriving via (FromProfunctor (PastroSum p)) instance Bimodule (->) Either Either (PastroSum p) -deriving via (FromProfunctor (TambaraSum p)) instance Profunctor p => Bimodule (->) Either Either (TambaraSum p) -deriving via (FromProfunctor (FreeTraversing p)) instance Bimodule (->) Either Either ( FreeTraversing p) -deriving via (FromProfunctor (CofreeTraversing p)) instance Profunctor p => Bimodule (->) Either Either (CofreeTraversing p) -deriving via (FromProfunctor (FreeMapping p )) instance Bimodule (->) Either Either (FreeMapping p) -deriving via (FromProfunctor (CofreeMapping p)) instance Profunctor p => Bimodule (->) Either Either (CofreeMapping p) -deriving via (FromProfunctor (Coyoneda p)) instance Choice p => Bimodule (->) Either Either (Coyoneda p) -deriving via (FromProfunctor (Yoneda p)) instance Choice p => Bimodule (->) Either Either (Yoneda p) -deriving via (FromProfunctor (->)) instance Bimodule (->) Either Either (->) -deriving via (FromProfunctor (Cokleisli w)) instance Comonad w => Bimodule (->) Either Either (Cokleisli w) -deriving via (FromProfunctor (Forget r)) instance Monoid r => Bimodule (->) Either Either (Forget r) -deriving via (FromProfunctor (Star f)) instance Applicative f => Bimodule (->) Either Either (Star f) -deriving via (FromProfunctor (Joker f)) instance Functor f => Bimodule (->) Either Either (Joker f) -deriving via (FromProfunctor (WrappedArrow p)) instance ArrowChoice p => Bimodule (->) Either Either (WrappedArrow p) -deriving via (FromProfunctor (Sum p q)) instance (Choice p, Choice q) => Bimodule (->) Either Either (Sum p q) -deriving via (FromProfunctor (Product p q)) instance (Choice p, Choice q) => Bimodule (->) Either Either (Product p q) -deriving via (FromProfunctor (Tannen f p)) instance (Functor f, Choice p) => Bimodule (->) Either Either (Tannen f p) -deriving via (FromProfunctor (Procompose p q)) instance (Choice p, Choice q) => Bimodule (->) Either Either (Procompose p q) -deriving via (FromProfunctor (Cayley f q)) instance (Functor f, Choice q) => Bimodule (->) Either Either (Cayley f q) - -deriving via (FromBifunctor Arg) instance Bimodule (->) Either Either Arg -deriving via (FromBifunctor Const) instance Bimodule (->) Either Either Const -deriving via (FromBifunctor Either) instance Bimodule (->) Either Either Either -deriving via (FromBifunctor These) instance Bimodule (->) Either Either These -deriving via (FromBifunctor (K1 i)) instance Bimodule (->) Either Either (K1 i :: Type -> Type -> Type) -deriving via (FromBifunctor (,)) instance Bimodule (->) Either Either (,) -deriving via (FromBifunctor ((,,) x1)) instance Bimodule (->) Either Either ((,,) x1) -deriving via (FromBifunctor ((,,,) x1 x2)) instance Bimodule (->) Either Either ((,,,) x1 x2) -deriving via (FromBifunctor ((,,,,) x1 x2 x3)) instance Bimodule (->) Either Either ((,,,,) x1 x2 x3) -deriving via (FromBifunctor ((,,,,,) x1 x2 x3 x4)) instance Bimodule (->) Either Either ((,,,,,) x1 x2 x3 x4) -deriving via (FromBifunctor ((,,,,,,) x1 x2 x3 x4 x5)) instance Bimodule (->) Either Either ((,,,,,,) x1 x2 x3 x4 x5) - -deriving via (FromBifunctor Arg) instance Bimodule (->) These These Arg -deriving via (FromBifunctor Const) instance Bimodule (->) These These Const -deriving via (FromBifunctor Either) instance Bimodule (->) These These Either -deriving via (FromBifunctor These) instance Bimodule (->) These These These -deriving via (FromBifunctor (K1 i)) instance Bimodule (->) These These (K1 i :: Type -> Type -> Type) -deriving via (FromBifunctor (,)) instance Bimodule (->) These These (,) -deriving via (FromBifunctor ((,,) x1)) instance Bimodule (->) These These ((,,) x1) -deriving via (FromBifunctor ((,,,) x1 x2)) instance Bimodule (->) These These ((,,,) x1 x2) -deriving via (FromBifunctor ((,,,,) x1 x2 x3)) instance Bimodule (->) These These ((,,,,) x1 x2 x3) -deriving via (FromBifunctor ((,,,,,) x1 x2 x3 x4)) instance Bimodule (->) These These ((,,,,,) x1 x2 x3 x4) -deriving via (FromBifunctor ((,,,,,,) x1 x2 x3 x4 x5)) instance Bimodule (->) These These ((,,,,,,) x1 x2 x3 x4 x5) - -deriving via (FromBifunctor Arg) instance Bimodule Op (,) (,) Arg -deriving via (FromBifunctor Const) instance Bimodule Op (,) (,) Const -deriving via (FromBifunctor Either) instance Bimodule Op (,) (,) Either -deriving via (FromBifunctor These) instance Bimodule Op (,) (,) These -deriving via (FromBifunctor (K1 i)) instance Bimodule Op (,) (,) (K1 i :: Type -> Type -> Type) -deriving via (FromBifunctor (,)) instance Bimodule Op (,) (,) (,) -deriving via (FromBifunctor ((,,) x1)) instance Bimodule Op (,) (,) ((,,) x1) -deriving via (FromBifunctor ((,,,) x1 x2)) instance Bimodule Op (,) (,) ((,,,) x1 x2) -deriving via (FromBifunctor ((,,,,) x1 x2 x3)) instance Bimodule Op (,) (,) ((,,,,) x1 x2 x3) -deriving via (FromBifunctor ((,,,,,) x1 x2 x3 x4)) instance Bimodule Op (,) (,) ((,,,,,) x1 x2 x3 x4) -deriving via (FromBifunctor ((,,,,,,) x1 x2 x3 x4 x5)) instance Bimodule Op (,) (,) ((,,,,,,) x1 x2 x3 x4 x5) - --------------------------------------------------------------------------------- - --- | A 'Profunctor' \(P : \mathcal{C}^{op} \times \mathcal{D} \to Set\) --- is a Tambara 'LeftCoModule' if it is equipped with a morphism \(s^{-1}_{a,b,m} : P(a \odot m, a \odot m) \to P(a, b) \), --- which we call 'lcostrength'. --- --- === Laws --- --- @ --- 'Data.Profunctor.Types.Data.Profunctor.Types.lmap' 'Control.Category.Cartesian.incll' ≡ 'lcostrength' 'Control.Category..' 'Data.Profunctor.Types.rmap' 'Control.Category.Cartesian.incll' --- 'lcostrength' 'Control.Category..' 'Data.Profunctor.Types.lmap' ('rstrength' f) ≡ 'lcostrength' 'Control.Category..' 'Data.Profunctor.Types.rmap' ('rstrength' f) --- 'lcostrength' 'Control.Category..' 'lcostrength' ≡ 'lcostrength' 'Control.Category..' 'Data.Profunctor.Types.dimap' ('Control.Category.Tensor.fwd' 'Control.Category.Tensor.assoc') ('Control.Category.Tensor.bwd' 'Control.Category.Tensor.assoc') --- @ -class LeftCoModule cat t1 t2 f where - -- | ==== __Examples__ - -- - -- 'Data.Profunctor.Strong.unfirst': - -- - -- >>> :t lcostrength @(->) @(,) @(,) - -- lcostrength @(->) @(,) @(,) :: LeftCoModule (->) (,) (,) f => f (a, x) (b, x) -> f a b - -- - -- 'Data.Profunctor.Choice.unleft': - -- - -- >>> :t lcostrength @(->) @Either @Either - -- lcostrength @(->) @Either @Either :: LeftCoModule (->) Either Either f => f (Either a x) (Either b x) -> f a b - lcostrength :: cat (f (t1 a x) (t2 b x)) (f a b) - -instance Costrong p => LeftCoModule (->) (,) (,) (FromProfunctor p) where - lcostrength :: FromProfunctor p (a, x) (b, x) -> FromProfunctor p a b - lcostrength = unfirst - -instance Cochoice p => LeftCoModule (->) Either Either (FromProfunctor p) where - lcostrength :: Cochoice p => FromProfunctor p (Either a x) (Either b x) -> FromProfunctor p a b - lcostrength = unleft - -instance Bifunctor p => LeftCoModule (->) (,) (,) (FromBifunctor p) where - lcostrength :: Bifunctor p => FromBifunctor p (a, x) (b, x) -> FromBifunctor p a b - lcostrength = gbimap fst fst - -instance Bifunctor p => LeftCoModule Op Either Either (FromBifunctor p) where - lcostrength :: Bifunctor p => Op (FromBifunctor p (Either a x) (Either b x)) (FromBifunctor p a b) - lcostrength = Op (gbimap Left Left) - -instance Bifunctor p => LeftCoModule Op These These (FromBifunctor p) where - lcostrength :: Bifunctor p => Op (FromBifunctor p (These a x) (These b x)) (FromBifunctor p a b) - lcostrength = Op (gbimap This This) - -deriving via (FromProfunctor (Kleisli m)) instance MonadFix m => LeftCoModule (->) (,) (,) (Kleisli m) -deriving via (FromProfunctor Tagged) instance LeftCoModule (->) (,) (,) Tagged -deriving via (FromProfunctor (Coyoneda p)) instance Costrong p => LeftCoModule (->) (,) (,) (Coyoneda p) -deriving via (FromProfunctor (Copastro p)) instance Cochoice p => LeftCoModule (->) (,) (,) (Copastro p) -deriving via (FromProfunctor (Yoneda p)) instance Costrong p => LeftCoModule (->) (,) (,) (Yoneda p) -deriving via (FromProfunctor (->)) instance LeftCoModule (->) (,) (,) (->) -deriving via (FromProfunctor (Cokleisli f)) instance Functor f => LeftCoModule (->) (,) (,) (Cokleisli f) -deriving via (FromProfunctor (Costar f)) instance Functor f => LeftCoModule (->) (,) (,) (Costar f) -deriving via (FromProfunctor (WrappedArrow p)) instance ArrowLoop p => LeftCoModule (->) (,) (,) (WrappedArrow p) -deriving via (FromProfunctor (Sum p q)) instance (Costrong p, Costrong q) => LeftCoModule (->) (,) (,) (Sum p q) -deriving via (FromProfunctor (Product p q)) instance (Costrong p, Costrong q) => LeftCoModule (->) (,) (,) (Product p q) -deriving via (FromProfunctor (Tannen f p)) instance (Functor f, Costrong p) => LeftCoModule (->) (,) (,) (Tannen f p) -deriving via (FromProfunctor (Procompose p q)) instance (Corepresentable p, Corepresentable q) => LeftCoModule (->) (,) (,) (Procompose p q) -deriving via (FromProfunctor (Cayley f p)) instance (Functor f, Costrong p) => LeftCoModule (->) (,) (,) (Cayley f p) - -deriving via (FromProfunctor (CopastroSum p)) instance LeftCoModule (->) Either Either (CopastroSum p) -deriving via (FromProfunctor (CotambaraSum p)) instance LeftCoModule (->) Either Either (CotambaraSum p) -deriving via (FromProfunctor (Coyoneda p)) instance Cochoice p => LeftCoModule (->) Either Either (Coyoneda p) -deriving via (FromProfunctor (Yoneda p)) instance Cochoice p => LeftCoModule (->) Either Either (Yoneda p) -deriving via (FromProfunctor (->)) instance LeftCoModule (->) Either Either (->) -deriving via (FromProfunctor (Forget r)) instance LeftCoModule (->) Either Either (Forget r) -deriving via (FromProfunctor (Costar f)) instance Applicative f => LeftCoModule (->) Either Either (Costar f) -deriving via (FromProfunctor (Star f)) instance Traversable f => LeftCoModule (->) Either Either (Star f) -deriving via (FromProfunctor (Sum p q)) instance (Cochoice p, Cochoice q) => LeftCoModule (->) Either Either (Sum p q) -deriving via (FromProfunctor (Product p q)) instance (Cochoice p, Cochoice q) => LeftCoModule (->) Either Either (Product p q) -deriving via (FromProfunctor (Tannen f p)) instance (Functor f, Cochoice p) => LeftCoModule (->) Either Either (Tannen f p) -deriving via (FromProfunctor (Cayley f p)) instance (Functor f, Cochoice p) => LeftCoModule (->) Either Either (Cayley f p) - -deriving via (FromBifunctor Arg) instance LeftCoModule (->) (,) (,) Arg -deriving via (FromBifunctor Const) instance LeftCoModule (->) (,) (,) Const -deriving via (FromBifunctor Either) instance LeftCoModule (->) (,) (,) Either -deriving via (FromBifunctor These) instance LeftCoModule (->) (,) (,) These -deriving via (FromBifunctor (K1 i)) instance LeftCoModule (->) (,) (,) (K1 i :: Type -> Type -> Type) -deriving via (FromBifunctor (,)) instance LeftCoModule (->) (,) (,) (,) -deriving via (FromBifunctor ((,,) x1)) instance LeftCoModule (->) (,) (,) ((,,) x1) -deriving via (FromBifunctor ((,,,) x1 x2)) instance LeftCoModule (->) (,) (,) ((,,,) x1 x2) -deriving via (FromBifunctor ((,,,,) x1 x2 x3)) instance LeftCoModule (->) (,) (,) ((,,,,) x1 x2 x3) -deriving via (FromBifunctor ((,,,,,) x1 x2 x3 x4)) instance LeftCoModule (->) (,) (,) ((,,,,,) x1 x2 x3 x4) -deriving via (FromBifunctor ((,,,,,,) x1 x2 x3 x4 x5)) instance LeftCoModule (->) (,) (,) ((,,,,,,) x1 x2 x3 x4 x5) - -deriving via (FromBifunctor Arg) instance LeftCoModule Op Either Either Arg -deriving via (FromBifunctor Const) instance LeftCoModule Op Either Either Const -deriving via (FromBifunctor Either) instance LeftCoModule Op Either Either Either -deriving via (FromBifunctor These) instance LeftCoModule Op Either Either These -deriving via (FromBifunctor (K1 i)) instance LeftCoModule Op Either Either (K1 i :: Type -> Type -> Type) -deriving via (FromBifunctor (,)) instance LeftCoModule Op Either Either (,) -deriving via (FromBifunctor ((,,) x1)) instance LeftCoModule Op Either Either ((,,) x1) -deriving via (FromBifunctor ((,,,) x1 x2)) instance LeftCoModule Op Either Either ((,,,) x1 x2) -deriving via (FromBifunctor ((,,,,) x1 x2 x3)) instance LeftCoModule Op Either Either ((,,,,) x1 x2 x3) -deriving via (FromBifunctor ((,,,,,) x1 x2 x3 x4)) instance LeftCoModule Op Either Either ((,,,,,) x1 x2 x3 x4) -deriving via (FromBifunctor ((,,,,,,) x1 x2 x3 x4 x5)) instance LeftCoModule Op Either Either ((,,,,,,) x1 x2 x3 x4 x5) - -deriving via (FromBifunctor Arg) instance LeftCoModule Op These These Arg -deriving via (FromBifunctor Const) instance LeftCoModule Op These These Const -deriving via (FromBifunctor Either) instance LeftCoModule Op These These Either -deriving via (FromBifunctor These) instance LeftCoModule Op These These These -deriving via (FromBifunctor (K1 i)) instance LeftCoModule Op These These (K1 i :: Type -> Type -> Type) -deriving via (FromBifunctor (,)) instance LeftCoModule Op These These (,) -deriving via (FromBifunctor ((,,) x1)) instance LeftCoModule Op These These ((,,) x1) -deriving via (FromBifunctor ((,,,) x1 x2)) instance LeftCoModule Op These These ((,,,) x1 x2) -deriving via (FromBifunctor ((,,,,) x1 x2 x3)) instance LeftCoModule Op These These ((,,,,) x1 x2 x3) -deriving via (FromBifunctor ((,,,,,) x1 x2 x3 x4)) instance LeftCoModule Op These These ((,,,,,) x1 x2 x3 x4) -deriving via (FromBifunctor ((,,,,,,) x1 x2 x3 x4 x5)) instance LeftCoModule Op These These ((,,,,,,) x1 x2 x3 x4 x5) - --------------------------------------------------------------------------------- - --- | A 'Profunctor' \(P : \mathcal{C}^{op} \times \mathcal{D} \to Set\) --- is a Tambara 'RightCoModule' if it is equipped with a morphism \(s^{-1}_{a,b,m} : P(m \odot a, m \odot a) \to P(a, b) \), --- which we call 'rcostrength'. --- --- === Laws --- --- @ --- 'Data.Profunctor.Types.Data.Profunctor.Types.lmap' 'Control.Category.Cartesian.inclr' ≡ 'rcostrength' 'Control.Category..' 'Data.Profunctor.Types.rmap' 'Control.Category.Cartesian.inclr' --- 'rcostrength' 'Control.Category..' 'Data.Profunctor.Types.lmap' ('lstrength' f) ≡ 'rcostrength' 'Control.Category..' 'Data.Profunctor.Types.rmap' ('lstrength' f) --- 'rcostrength' 'Control.Category..' 'rcostrength' ≡ 'rcostrength' 'Control.Category..' 'Data.Profunctor.Types.dimap' ('Control.Category.Tensor.bwd' 'Control.Category.Tensor.assoc') ('Control.Category.Tensor.fwd' 'Control.Category.Tensor.assoc') --- @ -class RightCoModule cat t1 t2 f where - -- | ==== __Examples__ - -- - -- 'Data.Profunctor.Strong.unsecond': - -- - -- >>> :t rcostrength @(->) @(,) @(,) - -- rcostrength @(->) @(,) @(,) :: RightCoModule (->) (,) (,) f => f (x, a) (x, b) -> f a b - -- - -- 'Data.Profunctor.Choice.unright': - -- - -- >>> :t rcostrength @(->) @Either @Either - -- rcostrength @(->) @Either @Either :: RightCoModule (->) Either Either f => f (Either x a) (Either x b) -> f a b - rcostrength :: cat (f (x `t1` a) (x `t2` b)) (f a b) - -instance Costrong p => RightCoModule (->) (,) (,) (FromProfunctor p) where - rcostrength :: FromProfunctor p (x, a) (x, b) -> FromProfunctor p a b - rcostrength = unsecond - -instance Cochoice p => RightCoModule (->) Either Either (FromProfunctor p) where - rcostrength :: FromProfunctor p (Either x a) (Either x b) -> FromProfunctor p a b - rcostrength = unright - -instance Bifunctor p => RightCoModule (->) (,) (,) (FromBifunctor p) where - rcostrength :: FromBifunctor p (x, a) (x, b) -> FromBifunctor p a b - rcostrength = gbimap snd snd - -instance Bifunctor p => RightCoModule Op Either Either (FromBifunctor p) where - rcostrength :: Op (FromBifunctor p (Either x a) (Either x b)) (FromBifunctor p a b) - rcostrength = Op (gbimap Right Right) - -instance Bifunctor p => RightCoModule Op These These (FromBifunctor p) where - rcostrength :: Op (FromBifunctor p (These x a) (These x b)) (FromBifunctor p a b) - rcostrength = Op (gbimap That That) - -deriving via (FromProfunctor (Kleisli m)) instance MonadFix m => RightCoModule (->) (,) (,) (Kleisli m) -deriving via (FromProfunctor Tagged) instance RightCoModule (->) (,) (,) Tagged -deriving via (FromProfunctor (Coyoneda p)) instance Costrong p => RightCoModule (->) (,) (,) (Coyoneda p) -deriving via (FromProfunctor (Copastro p)) instance Cochoice p => RightCoModule (->) (,) (,) (Copastro p) -deriving via (FromProfunctor (Yoneda p)) instance Costrong p => RightCoModule (->) (,) (,) (Yoneda p) -deriving via (FromProfunctor (->)) instance RightCoModule (->) (,) (,) (->) -deriving via (FromProfunctor (Cokleisli f)) instance Functor f => RightCoModule (->) (,) (,) (Cokleisli f) -deriving via (FromProfunctor (Costar f)) instance Functor f => RightCoModule (->) (,) (,) (Costar f) -deriving via (FromProfunctor (WrappedArrow p)) instance ArrowLoop p => RightCoModule (->) (,) (,) (WrappedArrow p) -deriving via (FromProfunctor (Sum p q)) instance (Costrong p, Costrong q) => RightCoModule (->) (,) (,) (Sum p q) -deriving via (FromProfunctor (Product p q)) instance (Costrong p, Costrong q) => RightCoModule (->) (,) (,) (Product p q) -deriving via (FromProfunctor (Tannen f p)) instance (Functor f, Costrong p) => RightCoModule (->) (,) (,) (Tannen f p) -deriving via (FromProfunctor (Procompose p q)) instance (Corepresentable p, Corepresentable q) => RightCoModule (->) (,) (,) (Procompose p q) -deriving via (FromProfunctor (Cayley f p)) instance (Functor f, Costrong p) => RightCoModule (->) (,) (,) (Cayley f p) - -deriving via (FromProfunctor (CopastroSum p)) instance RightCoModule (->) Either Either (CopastroSum p) -deriving via (FromProfunctor (CotambaraSum p)) instance RightCoModule (->) Either Either (CotambaraSum p) -deriving via (FromProfunctor (Coyoneda p)) instance Cochoice p => RightCoModule (->) Either Either (Coyoneda p) -deriving via (FromProfunctor (Yoneda p)) instance Cochoice p => RightCoModule (->) Either Either (Yoneda p) -deriving via (FromProfunctor (->)) instance RightCoModule (->) Either Either (->) -deriving via (FromProfunctor (Forget r)) instance RightCoModule (->) Either Either (Forget r) -deriving via (FromProfunctor (Costar f)) instance Applicative f => RightCoModule (->) Either Either (Costar f) -deriving via (FromProfunctor (Star f)) instance Traversable f => RightCoModule (->) Either Either (Star f) -deriving via (FromProfunctor (Sum p q)) instance (Cochoice p, Cochoice q) => RightCoModule (->) Either Either (Sum p q) -deriving via (FromProfunctor (Product p q)) instance (Cochoice p, Cochoice q) => RightCoModule (->) Either Either (Product p q) -deriving via (FromProfunctor (Tannen f p)) instance (Functor f, Cochoice p) => RightCoModule (->) Either Either (Tannen f p) -deriving via (FromProfunctor (Cayley f p)) instance (Functor f, Cochoice p) => RightCoModule (->) Either Either (Cayley f p) - -deriving via (FromBifunctor Arg) instance RightCoModule (->) (,) (,) Arg -deriving via (FromBifunctor Const) instance RightCoModule (->) (,) (,) Const -deriving via (FromBifunctor Either) instance RightCoModule (->) (,) (,) Either -deriving via (FromBifunctor These) instance RightCoModule (->) (,) (,) These -deriving via (FromBifunctor (K1 i)) instance RightCoModule (->) (,) (,) (K1 i :: Type -> Type -> Type) -deriving via (FromBifunctor (,)) instance RightCoModule (->) (,) (,) (,) -deriving via (FromBifunctor ((,,) x1)) instance RightCoModule (->) (,) (,) ((,,) x1) -deriving via (FromBifunctor ((,,,) x1 x2)) instance RightCoModule (->) (,) (,) ((,,,) x1 x2) -deriving via (FromBifunctor ((,,,,) x1 x2 x3)) instance RightCoModule (->) (,) (,) ((,,,,) x1 x2 x3) -deriving via (FromBifunctor ((,,,,,) x1 x2 x3 x4)) instance RightCoModule (->) (,) (,) ((,,,,,) x1 x2 x3 x4) -deriving via (FromBifunctor ((,,,,,,) x1 x2 x3 x4 x5)) instance RightCoModule (->) (,) (,) ((,,,,,,) x1 x2 x3 x4 x5) - -deriving via (FromBifunctor Arg) instance RightCoModule Op Either Either Arg -deriving via (FromBifunctor Const) instance RightCoModule Op Either Either Const -deriving via (FromBifunctor Either) instance RightCoModule Op Either Either Either -deriving via (FromBifunctor These) instance RightCoModule Op Either Either These -deriving via (FromBifunctor (K1 i)) instance RightCoModule Op Either Either (K1 i :: Type -> Type -> Type) -deriving via (FromBifunctor (,)) instance RightCoModule Op Either Either (,) -deriving via (FromBifunctor ((,,) x1)) instance RightCoModule Op Either Either ((,,) x1) -deriving via (FromBifunctor ((,,,) x1 x2)) instance RightCoModule Op Either Either ((,,,) x1 x2) -deriving via (FromBifunctor ((,,,,) x1 x2 x3)) instance RightCoModule Op Either Either ((,,,,) x1 x2 x3) -deriving via (FromBifunctor ((,,,,,) x1 x2 x3 x4)) instance RightCoModule Op Either Either ((,,,,,) x1 x2 x3 x4) -deriving via (FromBifunctor ((,,,,,,) x1 x2 x3 x4 x5)) instance RightCoModule Op Either Either ((,,,,,,) x1 x2 x3 x4 x5) - -deriving via (FromBifunctor Arg) instance RightCoModule Op These These Arg -deriving via (FromBifunctor Const) instance RightCoModule Op These These Const -deriving via (FromBifunctor Either) instance RightCoModule Op These These Either -deriving via (FromBifunctor These) instance RightCoModule Op These These These -deriving via (FromBifunctor (K1 i)) instance RightCoModule Op These These (K1 i :: Type -> Type -> Type) -deriving via (FromBifunctor (,)) instance RightCoModule Op These These (,) -deriving via (FromBifunctor ((,,) x1)) instance RightCoModule Op These These ((,,) x1) -deriving via (FromBifunctor ((,,,) x1 x2)) instance RightCoModule Op These These ((,,,) x1 x2) -deriving via (FromBifunctor ((,,,,) x1 x2 x3)) instance RightCoModule Op These These ((,,,,) x1 x2 x3) -deriving via (FromBifunctor ((,,,,,) x1 x2 x3 x4)) instance RightCoModule Op These These ((,,,,,) x1 x2 x3 x4) -deriving via (FromBifunctor ((,,,,,,) x1 x2 x3 x4 x5)) instance RightCoModule Op These These ((,,,,,,) x1 x2 x3 x4 x5) - --------------------------------------------------------------------------------- - --- | A 'Profunctor' equipped with both a Tambara 'LeftCoModule' and --- Tambara 'RightCoModule' is a 'CoBimodule'. --- --- === Laws --- --- @ --- 'rcostrength' ≡ 'lcostrength' 'Control.Category..' 'Data.Profunctor.Types.dimap' 'Control.Category.Tensor.swap' 'Control.Category.Tensor.swap' --- 'lcostrength' ≡ 'rcostrength' 'Control.Category..' 'Data.Profunctor.Types.dimap' 'Control.Category.Tensor.swap' 'Control.Category.Tensor.swap' --- @ -class (LeftCoModule cat t1 t2 f, RightCoModule cat t1 t2 f) => CoBimodule cat t1 t2 f - -instance Costrong p => CoBimodule (->) (,) (,) (FromProfunctor p) -instance Cochoice p => CoBimodule (->) Either Either (FromProfunctor p) -instance Bifunctor p => CoBimodule (->) (,) (,) (FromBifunctor p) -instance Bifunctor p => CoBimodule Op Either Either (FromBifunctor p) -instance Bifunctor p => CoBimodule Op These These (FromBifunctor p) - -deriving via (FromProfunctor (Kleisli m)) instance MonadFix m => CoBimodule (->) (,) (,) (Kleisli m) -deriving via (FromProfunctor Tagged) instance CoBimodule (->) (,) (,) Tagged -deriving via (FromProfunctor (Coyoneda p)) instance Costrong p => CoBimodule (->) (,) (,) (Coyoneda p) -deriving via (FromProfunctor (Copastro p)) instance Cochoice p => CoBimodule (->) (,) (,) (Copastro p) -deriving via (FromProfunctor (Yoneda p)) instance Costrong p => CoBimodule (->) (,) (,) (Yoneda p) -deriving via (FromProfunctor (->)) instance CoBimodule (->) (,) (,) (->) -deriving via (FromProfunctor (Cokleisli f)) instance Functor f => CoBimodule (->) (,) (,) (Cokleisli f) -deriving via (FromProfunctor (Costar f)) instance Functor f => CoBimodule (->) (,) (,) (Costar f) -deriving via (FromProfunctor (WrappedArrow p)) instance ArrowLoop p => CoBimodule (->) (,) (,) (WrappedArrow p) -deriving via (FromProfunctor (Sum p q)) instance (Costrong p, Costrong q) => CoBimodule (->) (,) (,) (Sum p q) -deriving via (FromProfunctor (Product p q)) instance (Costrong p, Costrong q) => CoBimodule (->) (,) (,) (Product p q) -deriving via (FromProfunctor (Tannen f p)) instance (Functor f, Costrong p) => CoBimodule (->) (,) (,) (Tannen f p) -deriving via (FromProfunctor (Procompose p q)) instance (Corepresentable p, Corepresentable q) => CoBimodule (->) (,) (,) (Procompose p q) -deriving via (FromProfunctor (Cayley f p)) instance (Functor f, Costrong p) => CoBimodule (->) (,) (,) (Cayley f p) - -deriving via (FromProfunctor (CopastroSum p)) instance CoBimodule (->) Either Either (CopastroSum p) -deriving via (FromProfunctor (CotambaraSum p)) instance CoBimodule (->) Either Either (CotambaraSum p) -deriving via (FromProfunctor (Coyoneda p)) instance Cochoice p => CoBimodule (->) Either Either (Coyoneda p) -deriving via (FromProfunctor (Yoneda p)) instance Cochoice p => CoBimodule (->) Either Either (Yoneda p) -deriving via (FromProfunctor (->)) instance CoBimodule (->) Either Either (->) -deriving via (FromProfunctor (Forget r)) instance CoBimodule (->) Either Either (Forget r) -deriving via (FromProfunctor (Costar f)) instance Applicative f => CoBimodule (->) Either Either (Costar f) -deriving via (FromProfunctor (Star f)) instance Traversable f => CoBimodule (->) Either Either (Star f) -deriving via (FromProfunctor (Sum p q)) instance (Cochoice p, Cochoice q) => CoBimodule (->) Either Either (Sum p q) -deriving via (FromProfunctor (Product p q)) instance (Cochoice p, Cochoice q) => CoBimodule (->) Either Either (Product p q) -deriving via (FromProfunctor (Tannen f p)) instance (Functor f, Cochoice p) => CoBimodule (->) Either Either (Tannen f p) -deriving via (FromProfunctor (Cayley f p)) instance (Functor f, Cochoice p) => CoBimodule (->) Either Either (Cayley f p) - -deriving via (FromBifunctor Arg) instance CoBimodule (->) (,) (,) Arg -deriving via (FromBifunctor Const) instance CoBimodule (->) (,) (,) Const -deriving via (FromBifunctor Either) instance CoBimodule (->) (,) (,) Either -deriving via (FromBifunctor These) instance CoBimodule (->) (,) (,) These -deriving via (FromBifunctor (K1 i)) instance CoBimodule (->) (,) (,) (K1 i :: Type -> Type -> Type) -deriving via (FromBifunctor (,)) instance CoBimodule (->) (,) (,) (,) -deriving via (FromBifunctor ((,,) x1)) instance CoBimodule (->) (,) (,) ((,,) x1) -deriving via (FromBifunctor ((,,,) x1 x2)) instance CoBimodule (->) (,) (,) ((,,,) x1 x2) -deriving via (FromBifunctor ((,,,,) x1 x2 x3)) instance CoBimodule (->) (,) (,) ((,,,,) x1 x2 x3) -deriving via (FromBifunctor ((,,,,,) x1 x2 x3 x4)) instance CoBimodule (->) (,) (,) ((,,,,,) x1 x2 x3 x4) -deriving via (FromBifunctor ((,,,,,,) x1 x2 x3 x4 x5)) instance CoBimodule (->) (,) (,) ((,,,,,,) x1 x2 x3 x4 x5) - -deriving via (FromBifunctor Arg) instance CoBimodule Op Either Either Arg -deriving via (FromBifunctor Const) instance CoBimodule Op Either Either Const -deriving via (FromBifunctor Either) instance CoBimodule Op Either Either Either -deriving via (FromBifunctor These) instance CoBimodule Op Either Either These -deriving via (FromBifunctor (K1 i)) instance CoBimodule Op Either Either (K1 i :: Type -> Type -> Type) -deriving via (FromBifunctor (,)) instance CoBimodule Op Either Either (,) -deriving via (FromBifunctor ((,,) x1)) instance CoBimodule Op Either Either ((,,) x1) -deriving via (FromBifunctor ((,,,) x1 x2)) instance CoBimodule Op Either Either ((,,,) x1 x2) -deriving via (FromBifunctor ((,,,,) x1 x2 x3)) instance CoBimodule Op Either Either ((,,,,) x1 x2 x3) -deriving via (FromBifunctor ((,,,,,) x1 x2 x3 x4)) instance CoBimodule Op Either Either ((,,,,,) x1 x2 x3 x4) -deriving via (FromBifunctor ((,,,,,,) x1 x2 x3 x4 x5)) instance CoBimodule Op Either Either ((,,,,,,) x1 x2 x3 x4 x5) - -deriving via (FromBifunctor Arg) instance CoBimodule Op These These Arg -deriving via (FromBifunctor Const) instance CoBimodule Op These These Const -deriving via (FromBifunctor Either) instance CoBimodule Op These These Either -deriving via (FromBifunctor These) instance CoBimodule Op These These These -deriving via (FromBifunctor (K1 i)) instance CoBimodule Op These These (K1 i :: Type -> Type -> Type) -deriving via (FromBifunctor (,)) instance CoBimodule Op These These (,) -deriving via (FromBifunctor ((,,) x1)) instance CoBimodule Op These These ((,,) x1) -deriving via (FromBifunctor ((,,,) x1 x2)) instance CoBimodule Op These These ((,,,) x1 x2) -deriving via (FromBifunctor ((,,,,) x1 x2 x3)) instance CoBimodule Op These These ((,,,,) x1 x2 x3) -deriving via (FromBifunctor ((,,,,,) x1 x2 x3 x4)) instance CoBimodule Op These These ((,,,,,) x1 x2 x3 x4) +import Data.These (These (That, This)) +import Data.Traversable (Traversable) +import Data.Tuple (fst, snd) +import GHC.Generics (K1 (..)) + +-------------------------------------------------------------------------------- + +-- | Boilerplate newtype to derive modules for any 'Profunctor'. +newtype FromProfunctor p a b = FromProfunctor (p a b) + deriving newtype (Functor, Profunctor, Strong, Choice, Costrong, Cochoice) + +-- | Boilerplate newtype to derive modules for any 'Bifunctor'. +newtype FromBifunctor p a b = FromBifunctor (p a b) + deriving newtype (Functor, Bifunctor) + +-------------------------------------------------------------------------------- + +-- | A 'Profunctor' \(P : \mathcal{C}^{op} \times \mathcal{D} \to Set\) +-- is a Tambara 'LeftModule' if it is equipped with a morphism \(s_{a,b,m} : P(a, b) \to P(a \odot m, b \odot m)\), +-- which we call 'lstrength'. +-- +-- === Laws +-- +-- @ +-- 'Types.lmap' 'Control.Category.Cartesian.projl' ≡ 'Types.rmap' 'Control.Category.Cartesian.projl' 'Control.Category..' 'lstrength' +-- 'Data.Profunctor.Types.lmap' ('rstrength' @f@) 'Control.Category..' 'lstrength' ≡ 'Data.Profunctor.Types.rmap' ('rstrength' @f@) 'Control.Category..' 'lstrength' +-- 'lstrength' 'Control.Category..' 'lstrength' ≡ 'Types.dimap' ('Control.Category.Tensor.bwd' 'Control.Category.Tensor.assoc') ('Control.Category.Tensor.fwd' 'Control.Category.Tensor.assoc') 'Control.Category..' 'lstrength' +-- @ +class LeftModule cat t1 t2 p where + -- | ==== __Examples__ + -- + -- 'Data.Profiunctor.Strong.first'': + -- + -- >>> :t lstrength @(->) @(,) @(,) + -- lstrength @(->) @(,) @(,) :: LeftModule (->) (,) (,) p => p a b -> p (a, x) (b, x) + -- + -- 'Data.Profiunctor.Choice.left'': + -- + -- >>> :t lstrength @(->) @Either @Either + -- lstrength @(->) @Either @Either :: LeftModule (->) Either Either p => p a b -> p (Either a x) (Either b x) + lstrength :: cat (p a b) (p (t1 a x) (t2 b x)) + +instance Strong p => LeftModule (->) (,) (,) (FromProfunctor p) where + lstrength :: FromProfunctor p a b -> FromProfunctor p (a, x) (b, x) + lstrength = first' + +instance Choice p => LeftModule (->) Either Either (FromProfunctor p) where + lstrength :: FromProfunctor p a b -> FromProfunctor p (Either a x) (Either b x) + lstrength = left' + +instance Bifunctor p => LeftModule (->) Either Either (FromBifunctor p) where + lstrength :: FromBifunctor p a b -> FromBifunctor p (Either a x) (Either b x) + lstrength = gbimap Left Left + +instance Bifunctor p => LeftModule (->) These These (FromBifunctor p) where + lstrength :: FromBifunctor p a b -> FromBifunctor p (These a x) (These b x) + lstrength = gbimap This This + +instance Bifunctor p => LeftModule Op (,) (,) (FromBifunctor p) where + lstrength :: Op (FromBifunctor p a b) (FromBifunctor p (a, x) (b, x)) + lstrength = Op (gbimap fst fst) + +deriving via (FromProfunctor (Kleisli m)) instance Monad m => LeftModule (->) (,) (,) (Kleisli m) + +deriving via (FromProfunctor (Pastro p)) instance LeftModule (->) (,) (,) (Pastro p) + +deriving via (FromProfunctor (Tambara p)) instance Profunctor p => LeftModule (->) (,) (,) (Tambara p) + +deriving via (FromProfunctor (Closure p)) instance Strong p => LeftModule (->) (,) (,) (Closure p) + +deriving via (FromProfunctor (FreeTraversing p)) instance LeftModule (->) (,) (,) (FreeTraversing p) + +deriving via (FromProfunctor (CofreeTraversing p)) instance Profunctor p => LeftModule (->) (,) (,) (CofreeTraversing p) + +deriving via (FromProfunctor (FreeMapping p)) instance LeftModule (->) (,) (,) (FreeMapping p) + +deriving via (FromProfunctor (CofreeMapping p)) instance Profunctor p => LeftModule (->) (,) (,) (CofreeMapping p) + +deriving via (FromProfunctor (Coyoneda p)) instance Strong p => LeftModule (->) (,) (,) (Coyoneda p) + +deriving via (FromProfunctor (Yoneda p)) instance Strong p => LeftModule (->) (,) (,) (Yoneda p) + +deriving via (FromProfunctor (->)) instance LeftModule (->) (,) (,) (->) + +deriving via (FromProfunctor (Forget r)) instance LeftModule (->) (,) (,) (Forget r) + +deriving via (FromProfunctor (Star m)) instance Functor m => LeftModule (->) (,) (,) (Star m) + +deriving via (FromProfunctor (Clown f)) instance Contravariant f => LeftModule (->) (,) (,) (Clown f) + +deriving via (FromProfunctor (WrappedArrow p)) instance Arrow p => LeftModule (->) (,) (,) (WrappedArrow p) + +deriving via (FromProfunctor (Sum p q)) instance (Strong p, Strong q) => LeftModule (->) (,) (,) (Sum p q) + +deriving via (FromProfunctor (Product p q)) instance (Strong p, Strong q) => LeftModule (->) (,) (,) (Product p q) + +deriving via (FromProfunctor (Tannen f q)) instance (Functor f, Strong q) => LeftModule (->) (,) (,) (Tannen f q) + +deriving via (FromProfunctor (Procompose p q)) instance (Strong p, Strong q) => LeftModule (->) (,) (,) (Procompose p q) + +deriving via (FromProfunctor (Cayley f q)) instance (Functor f, Strong q) => LeftModule (->) (,) (,) (Cayley f q) + +deriving via (FromProfunctor (Kleisli m)) instance Monad m => LeftModule (->) Either Either (Kleisli m) + +deriving via (FromProfunctor Tagged) instance LeftModule (->) Either Either Tagged + +deriving via (FromProfunctor (Tambara p)) instance (Choice p) => LeftModule (->) Either Either (Tambara p) + +deriving via (FromProfunctor (PastroSum p)) instance LeftModule (->) Either Either (PastroSum p) + +deriving via (FromProfunctor (TambaraSum p)) instance Profunctor p => LeftModule (->) Either Either (TambaraSum p) + +deriving via (FromProfunctor (FreeTraversing p)) instance LeftModule (->) Either Either (FreeTraversing p) + +deriving via (FromProfunctor (CofreeTraversing p)) instance Profunctor p => LeftModule (->) Either Either (CofreeTraversing p) + +deriving via (FromProfunctor (FreeMapping p)) instance LeftModule (->) Either Either (FreeMapping p) + +deriving via (FromProfunctor (CofreeMapping p)) instance Profunctor p => LeftModule (->) Either Either (CofreeMapping p) + +deriving via (FromProfunctor (Coyoneda p)) instance Choice p => LeftModule (->) Either Either (Coyoneda p) + +deriving via (FromProfunctor (Yoneda p)) instance Choice p => LeftModule (->) Either Either (Yoneda p) + +deriving via (FromProfunctor (->)) instance LeftModule (->) Either Either (->) + +deriving via (FromProfunctor (Cokleisli w)) instance Comonad w => LeftModule (->) Either Either (Cokleisli w) + +deriving via (FromProfunctor (Forget r)) instance Monoid r => LeftModule (->) Either Either (Forget r) + +deriving via (FromProfunctor (Star f)) instance Applicative f => LeftModule (->) Either Either (Star f) + +deriving via (FromProfunctor (Joker f)) instance Functor f => LeftModule (->) Either Either (Joker f) + +deriving via (FromProfunctor (WrappedArrow p)) instance ArrowChoice p => LeftModule (->) Either Either (WrappedArrow p) + +deriving via (FromProfunctor (Sum p q)) instance (Choice p, Choice q) => LeftModule (->) Either Either (Sum p q) + +deriving via (FromProfunctor (Product p q)) instance (Choice p, Choice q) => LeftModule (->) Either Either (Product p q) + +deriving via (FromProfunctor (Tannen f p)) instance (Functor f, Choice p) => LeftModule (->) Either Either (Tannen f p) + +deriving via (FromProfunctor (Procompose p q)) instance (Choice p, Choice q) => LeftModule (->) Either Either (Procompose p q) + +deriving via (FromProfunctor (Cayley f q)) instance (Functor f, Choice q) => LeftModule (->) Either Either (Cayley f q) + +deriving via (FromBifunctor Arg) instance LeftModule (->) Either Either Arg + +deriving via (FromBifunctor Const) instance LeftModule (->) Either Either Const + +deriving via (FromBifunctor Either) instance LeftModule (->) Either Either Either + +deriving via (FromBifunctor These) instance LeftModule (->) Either Either These + +deriving via (FromBifunctor (K1 i)) instance LeftModule (->) Either Either (K1 i :: Type -> Type -> Type) + +deriving via (FromBifunctor (,)) instance LeftModule (->) Either Either (,) + +deriving via (FromBifunctor ((,,) x1)) instance LeftModule (->) Either Either ((,,) x1) + +deriving via (FromBifunctor ((,,,) x1 x2)) instance LeftModule (->) Either Either ((,,,) x1 x2) + +deriving via (FromBifunctor ((,,,,) x1 x2 x3)) instance LeftModule (->) Either Either ((,,,,) x1 x2 x3) + +deriving via (FromBifunctor ((,,,,,) x1 x2 x3 x4)) instance LeftModule (->) Either Either ((,,,,,) x1 x2 x3 x4) + +deriving via (FromBifunctor ((,,,,,,) x1 x2 x3 x4 x5)) instance LeftModule (->) Either Either ((,,,,,,) x1 x2 x3 x4 x5) + +deriving via (FromBifunctor Arg) instance LeftModule (->) These These Arg + +deriving via (FromBifunctor Const) instance LeftModule (->) These These Const + +deriving via (FromBifunctor Either) instance LeftModule (->) These These Either + +deriving via (FromBifunctor These) instance LeftModule (->) These These These + +deriving via (FromBifunctor (K1 i)) instance LeftModule (->) These These (K1 i :: Type -> Type -> Type) + +deriving via (FromBifunctor (,)) instance LeftModule (->) These These (,) + +deriving via (FromBifunctor ((,,) x1)) instance LeftModule (->) These These ((,,) x1) + +deriving via (FromBifunctor ((,,,) x1 x2)) instance LeftModule (->) These These ((,,,) x1 x2) + +deriving via (FromBifunctor ((,,,,) x1 x2 x3)) instance LeftModule (->) These These ((,,,,) x1 x2 x3) + +deriving via (FromBifunctor ((,,,,,) x1 x2 x3 x4)) instance LeftModule (->) These These ((,,,,,) x1 x2 x3 x4) + +deriving via (FromBifunctor ((,,,,,,) x1 x2 x3 x4 x5)) instance LeftModule (->) These These ((,,,,,,) x1 x2 x3 x4 x5) + +deriving via (FromBifunctor Arg) instance LeftModule Op (,) (,) Arg + +deriving via (FromBifunctor Const) instance LeftModule Op (,) (,) Const + +deriving via (FromBifunctor Either) instance LeftModule Op (,) (,) Either + +deriving via (FromBifunctor These) instance LeftModule Op (,) (,) These + +deriving via (FromBifunctor (K1 i)) instance LeftModule Op (,) (,) (K1 i :: Type -> Type -> Type) + +deriving via (FromBifunctor (,)) instance LeftModule Op (,) (,) (,) + +deriving via (FromBifunctor ((,,) x1)) instance LeftModule Op (,) (,) ((,,) x1) + +deriving via (FromBifunctor ((,,,) x1 x2)) instance LeftModule Op (,) (,) ((,,,) x1 x2) + +deriving via (FromBifunctor ((,,,,) x1 x2 x3)) instance LeftModule Op (,) (,) ((,,,,) x1 x2 x3) + +deriving via (FromBifunctor ((,,,,,) x1 x2 x3 x4)) instance LeftModule Op (,) (,) ((,,,,,) x1 x2 x3 x4) + +deriving via (FromBifunctor ((,,,,,,) x1 x2 x3 x4 x5)) instance LeftModule Op (,) (,) ((,,,,,,) x1 x2 x3 x4 x5) + +-------------------------------------------------------------------------------- + +-- | A 'Profunctor' \(P : \mathcal{C}^{op} \times \mathcal{D} \to Set\) +-- is a Tambara 'RightModule' if it is equipped with a morphism \(s_{a,b,m} : P(a, b) \to P(m \odot a, m \odot b)\), +-- which we call 'rstrength'. +-- +-- === Laws +-- +-- @ +-- 'Data.Profunctor.Types.lmap' 'Control.Category.Cartesian.projr' ≡ 'Data.Profunctor.Types.rmap' 'Control.Category.Cartesian.projr' 'Control.Category..' 'rstrength' +-- 'Data.Profunctor.Types.lmap' ('lstrength' @f@) 'Control.Category..' 'rstrength' ≡ 'Data.Profunctor.Types.rmap' ('lstrength' @f@) 'Control.Category..' 'rstrength' +-- 'rstrength' 'Control.Category..' 'rstrength' ≡ 'Data.Profunctor.Types.dimap' ('Control.Category.Tensor.fwd' 'Control.Category.Tensor.assoc') ('Control.Category.Tensor.bwd' 'Control.Category.Tensor.assoc') 'Control.Category..' 'rstrength' +-- @ +class RightModule cat t1 t2 f where + -- | ==== __Examples__ + -- + -- 'Data.Profunctor.Strong.second'': + -- + -- >>> :t rstrength @(->) @(,) @(,) + -- rstrength @(->) @(,) @(,) :: RightModule (->) (,) (,) f => f a b -> f (x, a) (x, b) + -- + -- 'Data.Profunctor.Choice.right'': + -- + -- >>> :t rstrength @(->) @Either @Either + -- rstrength @(->) @Either @Either :: RightModule (->) Either Either f => f a b -> f (Either x a) (Either x b) + rstrength :: cat (f a b) (f (x `t1` a) (x `t2` b)) + +instance Strong p => RightModule (->) (,) (,) (FromProfunctor p) where + rstrength :: FromProfunctor p a b -> FromProfunctor p (c, a) (c, b) + rstrength = second' + +instance Choice p => RightModule (->) Either Either (FromProfunctor p) where + rstrength :: FromProfunctor p a b -> FromProfunctor p (Either c a) (Either c b) + rstrength = right' + +instance Bifunctor p => RightModule (->) Either Either (FromBifunctor p) where + rstrength :: FromBifunctor p a b -> FromBifunctor p (Either x a) (Either x b) + rstrength = gbimap Right Right + +instance Bifunctor p => RightModule (->) These These (FromBifunctor p) where + rstrength :: FromBifunctor p a b -> FromBifunctor p (These x a) (These x b) + rstrength = gbimap That That + +instance Bifunctor p => RightModule Op (,) (,) (FromBifunctor p) where + rstrength :: Op (FromBifunctor p a b) (FromBifunctor p (x, a) (x, b)) + rstrength = Op (gbimap snd snd) + +deriving via (FromProfunctor (Kleisli m)) instance Monad m => RightModule (->) (,) (,) (Kleisli m) + +deriving via (FromProfunctor (Pastro p)) instance RightModule (->) (,) (,) (Pastro p) + +deriving via (FromProfunctor (Tambara p)) instance Profunctor p => RightModule (->) (,) (,) (Tambara p) + +deriving via (FromProfunctor (Closure p)) instance Strong p => RightModule (->) (,) (,) (Closure p) + +deriving via (FromProfunctor (FreeTraversing p)) instance RightModule (->) (,) (,) (FreeTraversing p) + +deriving via (FromProfunctor (CofreeTraversing p)) instance Profunctor p => RightModule (->) (,) (,) (CofreeTraversing p) + +deriving via (FromProfunctor (FreeMapping p)) instance RightModule (->) (,) (,) (FreeMapping p) + +deriving via (FromProfunctor (CofreeMapping p)) instance Profunctor p => RightModule (->) (,) (,) (CofreeMapping p) + +deriving via (FromProfunctor (Coyoneda p)) instance Strong p => RightModule (->) (,) (,) (Coyoneda p) + +deriving via (FromProfunctor (Yoneda p)) instance Strong p => RightModule (->) (,) (,) (Yoneda p) + +deriving via (FromProfunctor (->)) instance RightModule (->) (,) (,) (->) + +deriving via (FromProfunctor (Forget r)) instance RightModule (->) (,) (,) (Forget r) + +deriving via (FromProfunctor (Star m)) instance Functor m => RightModule (->) (,) (,) (Star m) + +deriving via (FromProfunctor (Clown f)) instance Contravariant f => RightModule (->) (,) (,) (Clown f) + +deriving via (FromProfunctor (WrappedArrow p)) instance Arrow p => RightModule (->) (,) (,) (WrappedArrow p) + +deriving via (FromProfunctor (Sum p q)) instance (Strong p, Strong q) => RightModule (->) (,) (,) (Sum p q) + +deriving via (FromProfunctor (Product p q)) instance (Strong p, Strong q) => RightModule (->) (,) (,) (Product p q) + +deriving via (FromProfunctor (Tannen f q)) instance (Functor f, Strong q) => RightModule (->) (,) (,) (Tannen f q) + +deriving via (FromProfunctor (Procompose p q)) instance (Strong p, Strong q) => RightModule (->) (,) (,) (Procompose p q) + +deriving via (FromProfunctor (Cayley f q)) instance (Functor f, Strong q) => RightModule (->) (,) (,) (Cayley f q) + +deriving via (FromProfunctor (Kleisli m)) instance Monad m => RightModule (->) Either Either (Kleisli m) + +deriving via (FromProfunctor Tagged) instance RightModule (->) Either Either Tagged + +deriving via (FromProfunctor (Tambara p)) instance (Choice p) => RightModule (->) Either Either (Tambara p) + +deriving via (FromProfunctor (PastroSum p)) instance RightModule (->) Either Either (PastroSum p) + +deriving via (FromProfunctor (TambaraSum p)) instance Profunctor p => RightModule (->) Either Either (TambaraSum p) + +deriving via (FromProfunctor (FreeTraversing p)) instance RightModule (->) Either Either (FreeTraversing p) + +deriving via (FromProfunctor (CofreeTraversing p)) instance Profunctor p => RightModule (->) Either Either (CofreeTraversing p) + +deriving via (FromProfunctor (FreeMapping p)) instance RightModule (->) Either Either (FreeMapping p) + +deriving via (FromProfunctor (CofreeMapping p)) instance Profunctor p => RightModule (->) Either Either (CofreeMapping p) + +deriving via (FromProfunctor (Coyoneda p)) instance Choice p => RightModule (->) Either Either (Coyoneda p) + +deriving via (FromProfunctor (Yoneda p)) instance Choice p => RightModule (->) Either Either (Yoneda p) + +deriving via (FromProfunctor (->)) instance RightModule (->) Either Either (->) + +deriving via (FromProfunctor (Cokleisli w)) instance Comonad w => RightModule (->) Either Either (Cokleisli w) + +deriving via (FromProfunctor (Forget r)) instance Monoid r => RightModule (->) Either Either (Forget r) + +deriving via (FromProfunctor (Star f)) instance Applicative f => RightModule (->) Either Either (Star f) + +deriving via (FromProfunctor (Joker f)) instance Functor f => RightModule (->) Either Either (Joker f) + +deriving via (FromProfunctor (WrappedArrow p)) instance ArrowChoice p => RightModule (->) Either Either (WrappedArrow p) + +deriving via (FromProfunctor (Sum p q)) instance (Choice p, Choice q) => RightModule (->) Either Either (Sum p q) + +deriving via (FromProfunctor (Product p q)) instance (Choice p, Choice q) => RightModule (->) Either Either (Product p q) + +deriving via (FromProfunctor (Tannen f p)) instance (Functor f, Choice p) => RightModule (->) Either Either (Tannen f p) + +deriving via (FromProfunctor (Procompose p q)) instance (Choice p, Choice q) => RightModule (->) Either Either (Procompose p q) + +deriving via (FromProfunctor (Cayley f q)) instance (Functor f, Choice q) => RightModule (->) Either Either (Cayley f q) + +deriving via (FromBifunctor Arg) instance RightModule (->) Either Either Arg + +deriving via (FromBifunctor Const) instance RightModule (->) Either Either Const + +deriving via (FromBifunctor Either) instance RightModule (->) Either Either Either + +deriving via (FromBifunctor These) instance RightModule (->) Either Either These + +deriving via (FromBifunctor (K1 i)) instance RightModule (->) Either Either (K1 i :: Type -> Type -> Type) + +deriving via (FromBifunctor (,)) instance RightModule (->) Either Either (,) + +deriving via (FromBifunctor ((,,) x1)) instance RightModule (->) Either Either ((,,) x1) + +deriving via (FromBifunctor ((,,,) x1 x2)) instance RightModule (->) Either Either ((,,,) x1 x2) + +deriving via (FromBifunctor ((,,,,) x1 x2 x3)) instance RightModule (->) Either Either ((,,,,) x1 x2 x3) + +deriving via (FromBifunctor ((,,,,,) x1 x2 x3 x4)) instance RightModule (->) Either Either ((,,,,,) x1 x2 x3 x4) + +deriving via (FromBifunctor ((,,,,,,) x1 x2 x3 x4 x5)) instance RightModule (->) Either Either ((,,,,,,) x1 x2 x3 x4 x5) + +deriving via (FromBifunctor Arg) instance RightModule (->) These These Arg + +deriving via (FromBifunctor Const) instance RightModule (->) These These Const + +deriving via (FromBifunctor Either) instance RightModule (->) These These Either + +deriving via (FromBifunctor These) instance RightModule (->) These These These + +deriving via (FromBifunctor (K1 i)) instance RightModule (->) These These (K1 i :: Type -> Type -> Type) + +deriving via (FromBifunctor (,)) instance RightModule (->) These These (,) + +deriving via (FromBifunctor ((,,) x1)) instance RightModule (->) These These ((,,) x1) + +deriving via (FromBifunctor ((,,,) x1 x2)) instance RightModule (->) These These ((,,,) x1 x2) + +deriving via (FromBifunctor ((,,,,) x1 x2 x3)) instance RightModule (->) These These ((,,,,) x1 x2 x3) + +deriving via (FromBifunctor ((,,,,,) x1 x2 x3 x4)) instance RightModule (->) These These ((,,,,,) x1 x2 x3 x4) + +deriving via (FromBifunctor ((,,,,,,) x1 x2 x3 x4 x5)) instance RightModule (->) These These ((,,,,,,) x1 x2 x3 x4 x5) + +deriving via (FromBifunctor Arg) instance RightModule Op (,) (,) Arg + +deriving via (FromBifunctor Const) instance RightModule Op (,) (,) Const + +deriving via (FromBifunctor Either) instance RightModule Op (,) (,) Either + +deriving via (FromBifunctor These) instance RightModule Op (,) (,) These + +deriving via (FromBifunctor (K1 i)) instance RightModule Op (,) (,) (K1 i :: Type -> Type -> Type) + +deriving via (FromBifunctor (,)) instance RightModule Op (,) (,) (,) + +deriving via (FromBifunctor ((,,) x1)) instance RightModule Op (,) (,) ((,,) x1) + +deriving via (FromBifunctor ((,,,) x1 x2)) instance RightModule Op (,) (,) ((,,,) x1 x2) + +deriving via (FromBifunctor ((,,,,) x1 x2 x3)) instance RightModule Op (,) (,) ((,,,,) x1 x2 x3) + +deriving via (FromBifunctor ((,,,,,) x1 x2 x3 x4)) instance RightModule Op (,) (,) ((,,,,,) x1 x2 x3 x4) + +deriving via (FromBifunctor ((,,,,,,) x1 x2 x3 x4 x5)) instance RightModule Op (,) (,) ((,,,,,,) x1 x2 x3 x4 x5) + +-------------------------------------------------------------------------------- + +-- | A 'Profunctor' equipped with both a Tambara 'LeftModule' and +-- Tambara 'RightModule' is a 'Bimodule'. +-- +-- === Laws +-- +-- @ +-- 'rstrength' ≡ 'Data.Profunctor.Types.dimap' 'Control.Category.Tensor.swap' 'Control.Category.Tensor.swap' 'Control.Category..' 'lstrength' +-- 'lstrength' ≡ 'Data.Profunctor.Types.dimap' 'Control.Category.Tensor.swap' 'Control.Category.Tensor.swap' 'Control.Category..' 'rstrength' +-- @ +class (LeftModule cat t1 t2 f, RightModule cat t1 t2 f) => Bimodule cat t1 t2 f + +instance Strong p => Bimodule (->) (,) (,) (FromProfunctor p) + +instance Choice p => Bimodule (->) Either Either (FromProfunctor p) + +instance Bifunctor p => Bimodule (->) Either Either (FromBifunctor p) + +instance Bifunctor p => Bimodule (->) These These (FromBifunctor p) + +instance Bifunctor p => Bimodule Op (,) (,) (FromBifunctor p) + +deriving via (FromProfunctor (Kleisli m)) instance Monad m => Bimodule (->) (,) (,) (Kleisli m) + +deriving via (FromProfunctor (Pastro p)) instance Bimodule (->) (,) (,) (Pastro p) + +deriving via (FromProfunctor (Tambara p)) instance Profunctor p => Bimodule (->) (,) (,) (Tambara p) + +deriving via (FromProfunctor (Closure p)) instance Strong p => Bimodule (->) (,) (,) (Closure p) + +deriving via (FromProfunctor (FreeTraversing p)) instance Bimodule (->) (,) (,) (FreeTraversing p) + +deriving via (FromProfunctor (CofreeTraversing p)) instance Profunctor p => Bimodule (->) (,) (,) (CofreeTraversing p) + +deriving via (FromProfunctor (FreeMapping p)) instance Bimodule (->) (,) (,) (FreeMapping p) + +deriving via (FromProfunctor (CofreeMapping p)) instance Profunctor p => Bimodule (->) (,) (,) (CofreeMapping p) + +deriving via (FromProfunctor (Coyoneda p)) instance Strong p => Bimodule (->) (,) (,) (Coyoneda p) + +deriving via (FromProfunctor (Yoneda p)) instance Strong p => Bimodule (->) (,) (,) (Yoneda p) + +deriving via (FromProfunctor (->)) instance Bimodule (->) (,) (,) (->) + +deriving via (FromProfunctor (Forget r)) instance Bimodule (->) (,) (,) (Forget r) + +deriving via (FromProfunctor (Star m)) instance Functor m => Bimodule (->) (,) (,) (Star m) + +deriving via (FromProfunctor (Clown f)) instance Contravariant f => Bimodule (->) (,) (,) (Clown f) + +deriving via (FromProfunctor (WrappedArrow p)) instance Arrow p => Bimodule (->) (,) (,) (WrappedArrow p) + +deriving via (FromProfunctor (Sum p q)) instance (Strong p, Strong q) => Bimodule (->) (,) (,) (Sum p q) + +deriving via (FromProfunctor (Product p q)) instance (Strong p, Strong q) => Bimodule (->) (,) (,) (Product p q) + +deriving via (FromProfunctor (Tannen f q)) instance (Functor f, Strong q) => Bimodule (->) (,) (,) (Tannen f q) + +deriving via (FromProfunctor (Procompose p q)) instance (Strong p, Strong q) => Bimodule (->) (,) (,) (Procompose p q) + +deriving via (FromProfunctor (Cayley f q)) instance (Functor f, Strong q) => Bimodule (->) (,) (,) (Cayley f q) + +deriving via (FromProfunctor (Kleisli m)) instance Monad m => Bimodule (->) Either Either (Kleisli m) + +deriving via (FromProfunctor Tagged) instance Bimodule (->) Either Either Tagged + +deriving via (FromProfunctor (Tambara p)) instance (Choice p) => Bimodule (->) Either Either (Tambara p) + +deriving via (FromProfunctor (PastroSum p)) instance Bimodule (->) Either Either (PastroSum p) + +deriving via (FromProfunctor (TambaraSum p)) instance Profunctor p => Bimodule (->) Either Either (TambaraSum p) + +deriving via (FromProfunctor (FreeTraversing p)) instance Bimodule (->) Either Either (FreeTraversing p) + +deriving via (FromProfunctor (CofreeTraversing p)) instance Profunctor p => Bimodule (->) Either Either (CofreeTraversing p) + +deriving via (FromProfunctor (FreeMapping p)) instance Bimodule (->) Either Either (FreeMapping p) + +deriving via (FromProfunctor (CofreeMapping p)) instance Profunctor p => Bimodule (->) Either Either (CofreeMapping p) + +deriving via (FromProfunctor (Coyoneda p)) instance Choice p => Bimodule (->) Either Either (Coyoneda p) + +deriving via (FromProfunctor (Yoneda p)) instance Choice p => Bimodule (->) Either Either (Yoneda p) + +deriving via (FromProfunctor (->)) instance Bimodule (->) Either Either (->) + +deriving via (FromProfunctor (Cokleisli w)) instance Comonad w => Bimodule (->) Either Either (Cokleisli w) + +deriving via (FromProfunctor (Forget r)) instance Monoid r => Bimodule (->) Either Either (Forget r) + +deriving via (FromProfunctor (Star f)) instance Applicative f => Bimodule (->) Either Either (Star f) + +deriving via (FromProfunctor (Joker f)) instance Functor f => Bimodule (->) Either Either (Joker f) + +deriving via (FromProfunctor (WrappedArrow p)) instance ArrowChoice p => Bimodule (->) Either Either (WrappedArrow p) + +deriving via (FromProfunctor (Sum p q)) instance (Choice p, Choice q) => Bimodule (->) Either Either (Sum p q) + +deriving via (FromProfunctor (Product p q)) instance (Choice p, Choice q) => Bimodule (->) Either Either (Product p q) + +deriving via (FromProfunctor (Tannen f p)) instance (Functor f, Choice p) => Bimodule (->) Either Either (Tannen f p) + +deriving via (FromProfunctor (Procompose p q)) instance (Choice p, Choice q) => Bimodule (->) Either Either (Procompose p q) + +deriving via (FromProfunctor (Cayley f q)) instance (Functor f, Choice q) => Bimodule (->) Either Either (Cayley f q) + +deriving via (FromBifunctor Arg) instance Bimodule (->) Either Either Arg + +deriving via (FromBifunctor Const) instance Bimodule (->) Either Either Const + +deriving via (FromBifunctor Either) instance Bimodule (->) Either Either Either + +deriving via (FromBifunctor These) instance Bimodule (->) Either Either These + +deriving via (FromBifunctor (K1 i)) instance Bimodule (->) Either Either (K1 i :: Type -> Type -> Type) + +deriving via (FromBifunctor (,)) instance Bimodule (->) Either Either (,) + +deriving via (FromBifunctor ((,,) x1)) instance Bimodule (->) Either Either ((,,) x1) + +deriving via (FromBifunctor ((,,,) x1 x2)) instance Bimodule (->) Either Either ((,,,) x1 x2) + +deriving via (FromBifunctor ((,,,,) x1 x2 x3)) instance Bimodule (->) Either Either ((,,,,) x1 x2 x3) + +deriving via (FromBifunctor ((,,,,,) x1 x2 x3 x4)) instance Bimodule (->) Either Either ((,,,,,) x1 x2 x3 x4) + +deriving via (FromBifunctor ((,,,,,,) x1 x2 x3 x4 x5)) instance Bimodule (->) Either Either ((,,,,,,) x1 x2 x3 x4 x5) + +deriving via (FromBifunctor Arg) instance Bimodule (->) These These Arg + +deriving via (FromBifunctor Const) instance Bimodule (->) These These Const + +deriving via (FromBifunctor Either) instance Bimodule (->) These These Either + +deriving via (FromBifunctor These) instance Bimodule (->) These These These + +deriving via (FromBifunctor (K1 i)) instance Bimodule (->) These These (K1 i :: Type -> Type -> Type) + +deriving via (FromBifunctor (,)) instance Bimodule (->) These These (,) + +deriving via (FromBifunctor ((,,) x1)) instance Bimodule (->) These These ((,,) x1) + +deriving via (FromBifunctor ((,,,) x1 x2)) instance Bimodule (->) These These ((,,,) x1 x2) + +deriving via (FromBifunctor ((,,,,) x1 x2 x3)) instance Bimodule (->) These These ((,,,,) x1 x2 x3) + +deriving via (FromBifunctor ((,,,,,) x1 x2 x3 x4)) instance Bimodule (->) These These ((,,,,,) x1 x2 x3 x4) + +deriving via (FromBifunctor ((,,,,,,) x1 x2 x3 x4 x5)) instance Bimodule (->) These These ((,,,,,,) x1 x2 x3 x4 x5) + +deriving via (FromBifunctor Arg) instance Bimodule Op (,) (,) Arg + +deriving via (FromBifunctor Const) instance Bimodule Op (,) (,) Const + +deriving via (FromBifunctor Either) instance Bimodule Op (,) (,) Either + +deriving via (FromBifunctor These) instance Bimodule Op (,) (,) These + +deriving via (FromBifunctor (K1 i)) instance Bimodule Op (,) (,) (K1 i :: Type -> Type -> Type) + +deriving via (FromBifunctor (,)) instance Bimodule Op (,) (,) (,) + +deriving via (FromBifunctor ((,,) x1)) instance Bimodule Op (,) (,) ((,,) x1) + +deriving via (FromBifunctor ((,,,) x1 x2)) instance Bimodule Op (,) (,) ((,,,) x1 x2) + +deriving via (FromBifunctor ((,,,,) x1 x2 x3)) instance Bimodule Op (,) (,) ((,,,,) x1 x2 x3) + +deriving via (FromBifunctor ((,,,,,) x1 x2 x3 x4)) instance Bimodule Op (,) (,) ((,,,,,) x1 x2 x3 x4) + +deriving via (FromBifunctor ((,,,,,,) x1 x2 x3 x4 x5)) instance Bimodule Op (,) (,) ((,,,,,,) x1 x2 x3 x4 x5) + +-------------------------------------------------------------------------------- + +-- | A 'Profunctor' \(P : \mathcal{C}^{op} \times \mathcal{D} \to Set\) +-- is a Tambara 'LeftCoModule' if it is equipped with a morphism \(s^{-1}_{a,b,m} : P(a \odot m, a \odot m) \to P(a, b) \), +-- which we call 'lcostrength'. +-- +-- === Laws +-- +-- @ +-- 'Data.Profunctor.Types.Data.Profunctor.Types.lmap' 'Control.Category.Cartesian.incll' ≡ 'lcostrength' 'Control.Category..' 'Data.Profunctor.Types.rmap' 'Control.Category.Cartesian.incll' +-- 'lcostrength' 'Control.Category..' 'Data.Profunctor.Types.lmap' ('rstrength' f) ≡ 'lcostrength' 'Control.Category..' 'Data.Profunctor.Types.rmap' ('rstrength' f) +-- 'lcostrength' 'Control.Category..' 'lcostrength' ≡ 'lcostrength' 'Control.Category..' 'Data.Profunctor.Types.dimap' ('Control.Category.Tensor.fwd' 'Control.Category.Tensor.assoc') ('Control.Category.Tensor.bwd' 'Control.Category.Tensor.assoc') +-- @ +class LeftCoModule cat t1 t2 f where + -- | ==== __Examples__ + -- + -- 'Data.Profunctor.Strong.unfirst': + -- + -- >>> :t lcostrength @(->) @(,) @(,) + -- lcostrength @(->) @(,) @(,) :: LeftCoModule (->) (,) (,) f => f (a, x) (b, x) -> f a b + -- + -- 'Data.Profunctor.Choice.unleft': + -- + -- >>> :t lcostrength @(->) @Either @Either + -- lcostrength @(->) @Either @Either :: LeftCoModule (->) Either Either f => f (Either a x) (Either b x) -> f a b + lcostrength :: cat (f (t1 a x) (t2 b x)) (f a b) + +instance Costrong p => LeftCoModule (->) (,) (,) (FromProfunctor p) where + lcostrength :: FromProfunctor p (a, x) (b, x) -> FromProfunctor p a b + lcostrength = unfirst + +instance Cochoice p => LeftCoModule (->) Either Either (FromProfunctor p) where + lcostrength :: Cochoice p => FromProfunctor p (Either a x) (Either b x) -> FromProfunctor p a b + lcostrength = unleft + +instance Bifunctor p => LeftCoModule (->) (,) (,) (FromBifunctor p) where + lcostrength :: Bifunctor p => FromBifunctor p (a, x) (b, x) -> FromBifunctor p a b + lcostrength = gbimap fst fst + +instance Bifunctor p => LeftCoModule Op Either Either (FromBifunctor p) where + lcostrength :: Bifunctor p => Op (FromBifunctor p (Either a x) (Either b x)) (FromBifunctor p a b) + lcostrength = Op (gbimap Left Left) + +instance Bifunctor p => LeftCoModule Op These These (FromBifunctor p) where + lcostrength :: Bifunctor p => Op (FromBifunctor p (These a x) (These b x)) (FromBifunctor p a b) + lcostrength = Op (gbimap This This) + +deriving via (FromProfunctor (Kleisli m)) instance MonadFix m => LeftCoModule (->) (,) (,) (Kleisli m) + +deriving via (FromProfunctor Tagged) instance LeftCoModule (->) (,) (,) Tagged + +deriving via (FromProfunctor (Coyoneda p)) instance Costrong p => LeftCoModule (->) (,) (,) (Coyoneda p) + +deriving via (FromProfunctor (Copastro p)) instance Cochoice p => LeftCoModule (->) (,) (,) (Copastro p) + +deriving via (FromProfunctor (Yoneda p)) instance Costrong p => LeftCoModule (->) (,) (,) (Yoneda p) + +deriving via (FromProfunctor (->)) instance LeftCoModule (->) (,) (,) (->) + +deriving via (FromProfunctor (Cokleisli f)) instance Functor f => LeftCoModule (->) (,) (,) (Cokleisli f) + +deriving via (FromProfunctor (Costar f)) instance Functor f => LeftCoModule (->) (,) (,) (Costar f) + +deriving via (FromProfunctor (WrappedArrow p)) instance ArrowLoop p => LeftCoModule (->) (,) (,) (WrappedArrow p) + +deriving via (FromProfunctor (Sum p q)) instance (Costrong p, Costrong q) => LeftCoModule (->) (,) (,) (Sum p q) + +deriving via (FromProfunctor (Product p q)) instance (Costrong p, Costrong q) => LeftCoModule (->) (,) (,) (Product p q) + +deriving via (FromProfunctor (Tannen f p)) instance (Functor f, Costrong p) => LeftCoModule (->) (,) (,) (Tannen f p) + +deriving via (FromProfunctor (Procompose p q)) instance (Corepresentable p, Corepresentable q) => LeftCoModule (->) (,) (,) (Procompose p q) + +deriving via (FromProfunctor (Cayley f p)) instance (Functor f, Costrong p) => LeftCoModule (->) (,) (,) (Cayley f p) + +deriving via (FromProfunctor (CopastroSum p)) instance LeftCoModule (->) Either Either (CopastroSum p) + +deriving via (FromProfunctor (CotambaraSum p)) instance LeftCoModule (->) Either Either (CotambaraSum p) + +deriving via (FromProfunctor (Coyoneda p)) instance Cochoice p => LeftCoModule (->) Either Either (Coyoneda p) + +deriving via (FromProfunctor (Yoneda p)) instance Cochoice p => LeftCoModule (->) Either Either (Yoneda p) + +deriving via (FromProfunctor (->)) instance LeftCoModule (->) Either Either (->) + +deriving via (FromProfunctor (Forget r)) instance LeftCoModule (->) Either Either (Forget r) + +deriving via (FromProfunctor (Costar f)) instance Applicative f => LeftCoModule (->) Either Either (Costar f) + +deriving via (FromProfunctor (Star f)) instance Traversable f => LeftCoModule (->) Either Either (Star f) + +deriving via (FromProfunctor (Sum p q)) instance (Cochoice p, Cochoice q) => LeftCoModule (->) Either Either (Sum p q) + +deriving via (FromProfunctor (Product p q)) instance (Cochoice p, Cochoice q) => LeftCoModule (->) Either Either (Product p q) + +deriving via (FromProfunctor (Tannen f p)) instance (Functor f, Cochoice p) => LeftCoModule (->) Either Either (Tannen f p) + +deriving via (FromProfunctor (Cayley f p)) instance (Functor f, Cochoice p) => LeftCoModule (->) Either Either (Cayley f p) + +deriving via (FromBifunctor Arg) instance LeftCoModule (->) (,) (,) Arg + +deriving via (FromBifunctor Const) instance LeftCoModule (->) (,) (,) Const + +deriving via (FromBifunctor Either) instance LeftCoModule (->) (,) (,) Either + +deriving via (FromBifunctor These) instance LeftCoModule (->) (,) (,) These + +deriving via (FromBifunctor (K1 i)) instance LeftCoModule (->) (,) (,) (K1 i :: Type -> Type -> Type) + +deriving via (FromBifunctor (,)) instance LeftCoModule (->) (,) (,) (,) + +deriving via (FromBifunctor ((,,) x1)) instance LeftCoModule (->) (,) (,) ((,,) x1) + +deriving via (FromBifunctor ((,,,) x1 x2)) instance LeftCoModule (->) (,) (,) ((,,,) x1 x2) + +deriving via (FromBifunctor ((,,,,) x1 x2 x3)) instance LeftCoModule (->) (,) (,) ((,,,,) x1 x2 x3) + +deriving via (FromBifunctor ((,,,,,) x1 x2 x3 x4)) instance LeftCoModule (->) (,) (,) ((,,,,,) x1 x2 x3 x4) + +deriving via (FromBifunctor ((,,,,,,) x1 x2 x3 x4 x5)) instance LeftCoModule (->) (,) (,) ((,,,,,,) x1 x2 x3 x4 x5) + +deriving via (FromBifunctor Arg) instance LeftCoModule Op Either Either Arg + +deriving via (FromBifunctor Const) instance LeftCoModule Op Either Either Const + +deriving via (FromBifunctor Either) instance LeftCoModule Op Either Either Either + +deriving via (FromBifunctor These) instance LeftCoModule Op Either Either These + +deriving via (FromBifunctor (K1 i)) instance LeftCoModule Op Either Either (K1 i :: Type -> Type -> Type) + +deriving via (FromBifunctor (,)) instance LeftCoModule Op Either Either (,) + +deriving via (FromBifunctor ((,,) x1)) instance LeftCoModule Op Either Either ((,,) x1) + +deriving via (FromBifunctor ((,,,) x1 x2)) instance LeftCoModule Op Either Either ((,,,) x1 x2) + +deriving via (FromBifunctor ((,,,,) x1 x2 x3)) instance LeftCoModule Op Either Either ((,,,,) x1 x2 x3) + +deriving via (FromBifunctor ((,,,,,) x1 x2 x3 x4)) instance LeftCoModule Op Either Either ((,,,,,) x1 x2 x3 x4) + +deriving via (FromBifunctor ((,,,,,,) x1 x2 x3 x4 x5)) instance LeftCoModule Op Either Either ((,,,,,,) x1 x2 x3 x4 x5) + +deriving via (FromBifunctor Arg) instance LeftCoModule Op These These Arg + +deriving via (FromBifunctor Const) instance LeftCoModule Op These These Const + +deriving via (FromBifunctor Either) instance LeftCoModule Op These These Either + +deriving via (FromBifunctor These) instance LeftCoModule Op These These These + +deriving via (FromBifunctor (K1 i)) instance LeftCoModule Op These These (K1 i :: Type -> Type -> Type) + +deriving via (FromBifunctor (,)) instance LeftCoModule Op These These (,) + +deriving via (FromBifunctor ((,,) x1)) instance LeftCoModule Op These These ((,,) x1) + +deriving via (FromBifunctor ((,,,) x1 x2)) instance LeftCoModule Op These These ((,,,) x1 x2) + +deriving via (FromBifunctor ((,,,,) x1 x2 x3)) instance LeftCoModule Op These These ((,,,,) x1 x2 x3) + +deriving via (FromBifunctor ((,,,,,) x1 x2 x3 x4)) instance LeftCoModule Op These These ((,,,,,) x1 x2 x3 x4) + +deriving via (FromBifunctor ((,,,,,,) x1 x2 x3 x4 x5)) instance LeftCoModule Op These These ((,,,,,,) x1 x2 x3 x4 x5) + +-------------------------------------------------------------------------------- + +-- | A 'Profunctor' \(P : \mathcal{C}^{op} \times \mathcal{D} \to Set\) +-- is a Tambara 'RightCoModule' if it is equipped with a morphism \(s^{-1}_{a,b,m} : P(m \odot a, m \odot a) \to P(a, b) \), +-- which we call 'rcostrength'. +-- +-- === Laws +-- +-- @ +-- 'Data.Profunctor.Types.Data.Profunctor.Types.lmap' 'Control.Category.Cartesian.inclr' ≡ 'rcostrength' 'Control.Category..' 'Data.Profunctor.Types.rmap' 'Control.Category.Cartesian.inclr' +-- 'rcostrength' 'Control.Category..' 'Data.Profunctor.Types.lmap' ('lstrength' f) ≡ 'rcostrength' 'Control.Category..' 'Data.Profunctor.Types.rmap' ('lstrength' f) +-- 'rcostrength' 'Control.Category..' 'rcostrength' ≡ 'rcostrength' 'Control.Category..' 'Data.Profunctor.Types.dimap' ('Control.Category.Tensor.bwd' 'Control.Category.Tensor.assoc') ('Control.Category.Tensor.fwd' 'Control.Category.Tensor.assoc') +-- @ +class RightCoModule cat t1 t2 f where + -- | ==== __Examples__ + -- + -- 'Data.Profunctor.Strong.unsecond': + -- + -- >>> :t rcostrength @(->) @(,) @(,) + -- rcostrength @(->) @(,) @(,) :: RightCoModule (->) (,) (,) f => f (x, a) (x, b) -> f a b + -- + -- 'Data.Profunctor.Choice.unright': + -- + -- >>> :t rcostrength @(->) @Either @Either + -- rcostrength @(->) @Either @Either :: RightCoModule (->) Either Either f => f (Either x a) (Either x b) -> f a b + rcostrength :: cat (f (x `t1` a) (x `t2` b)) (f a b) + +instance Costrong p => RightCoModule (->) (,) (,) (FromProfunctor p) where + rcostrength :: FromProfunctor p (x, a) (x, b) -> FromProfunctor p a b + rcostrength = unsecond + +instance Cochoice p => RightCoModule (->) Either Either (FromProfunctor p) where + rcostrength :: FromProfunctor p (Either x a) (Either x b) -> FromProfunctor p a b + rcostrength = unright + +instance Bifunctor p => RightCoModule (->) (,) (,) (FromBifunctor p) where + rcostrength :: FromBifunctor p (x, a) (x, b) -> FromBifunctor p a b + rcostrength = gbimap snd snd + +instance Bifunctor p => RightCoModule Op Either Either (FromBifunctor p) where + rcostrength :: Op (FromBifunctor p (Either x a) (Either x b)) (FromBifunctor p a b) + rcostrength = Op (gbimap Right Right) + +instance Bifunctor p => RightCoModule Op These These (FromBifunctor p) where + rcostrength :: Op (FromBifunctor p (These x a) (These x b)) (FromBifunctor p a b) + rcostrength = Op (gbimap That That) + +deriving via (FromProfunctor (Kleisli m)) instance MonadFix m => RightCoModule (->) (,) (,) (Kleisli m) + +deriving via (FromProfunctor Tagged) instance RightCoModule (->) (,) (,) Tagged + +deriving via (FromProfunctor (Coyoneda p)) instance Costrong p => RightCoModule (->) (,) (,) (Coyoneda p) + +deriving via (FromProfunctor (Copastro p)) instance Cochoice p => RightCoModule (->) (,) (,) (Copastro p) + +deriving via (FromProfunctor (Yoneda p)) instance Costrong p => RightCoModule (->) (,) (,) (Yoneda p) + +deriving via (FromProfunctor (->)) instance RightCoModule (->) (,) (,) (->) + +deriving via (FromProfunctor (Cokleisli f)) instance Functor f => RightCoModule (->) (,) (,) (Cokleisli f) + +deriving via (FromProfunctor (Costar f)) instance Functor f => RightCoModule (->) (,) (,) (Costar f) + +deriving via (FromProfunctor (WrappedArrow p)) instance ArrowLoop p => RightCoModule (->) (,) (,) (WrappedArrow p) + +deriving via (FromProfunctor (Sum p q)) instance (Costrong p, Costrong q) => RightCoModule (->) (,) (,) (Sum p q) + +deriving via (FromProfunctor (Product p q)) instance (Costrong p, Costrong q) => RightCoModule (->) (,) (,) (Product p q) + +deriving via (FromProfunctor (Tannen f p)) instance (Functor f, Costrong p) => RightCoModule (->) (,) (,) (Tannen f p) + +deriving via (FromProfunctor (Procompose p q)) instance (Corepresentable p, Corepresentable q) => RightCoModule (->) (,) (,) (Procompose p q) + +deriving via (FromProfunctor (Cayley f p)) instance (Functor f, Costrong p) => RightCoModule (->) (,) (,) (Cayley f p) + +deriving via (FromProfunctor (CopastroSum p)) instance RightCoModule (->) Either Either (CopastroSum p) + +deriving via (FromProfunctor (CotambaraSum p)) instance RightCoModule (->) Either Either (CotambaraSum p) + +deriving via (FromProfunctor (Coyoneda p)) instance Cochoice p => RightCoModule (->) Either Either (Coyoneda p) + +deriving via (FromProfunctor (Yoneda p)) instance Cochoice p => RightCoModule (->) Either Either (Yoneda p) + +deriving via (FromProfunctor (->)) instance RightCoModule (->) Either Either (->) + +deriving via (FromProfunctor (Forget r)) instance RightCoModule (->) Either Either (Forget r) + +deriving via (FromProfunctor (Costar f)) instance Applicative f => RightCoModule (->) Either Either (Costar f) + +deriving via (FromProfunctor (Star f)) instance Traversable f => RightCoModule (->) Either Either (Star f) + +deriving via (FromProfunctor (Sum p q)) instance (Cochoice p, Cochoice q) => RightCoModule (->) Either Either (Sum p q) + +deriving via (FromProfunctor (Product p q)) instance (Cochoice p, Cochoice q) => RightCoModule (->) Either Either (Product p q) + +deriving via (FromProfunctor (Tannen f p)) instance (Functor f, Cochoice p) => RightCoModule (->) Either Either (Tannen f p) + +deriving via (FromProfunctor (Cayley f p)) instance (Functor f, Cochoice p) => RightCoModule (->) Either Either (Cayley f p) + +deriving via (FromBifunctor Arg) instance RightCoModule (->) (,) (,) Arg + +deriving via (FromBifunctor Const) instance RightCoModule (->) (,) (,) Const + +deriving via (FromBifunctor Either) instance RightCoModule (->) (,) (,) Either + +deriving via (FromBifunctor These) instance RightCoModule (->) (,) (,) These + +deriving via (FromBifunctor (K1 i)) instance RightCoModule (->) (,) (,) (K1 i :: Type -> Type -> Type) + +deriving via (FromBifunctor (,)) instance RightCoModule (->) (,) (,) (,) + +deriving via (FromBifunctor ((,,) x1)) instance RightCoModule (->) (,) (,) ((,,) x1) + +deriving via (FromBifunctor ((,,,) x1 x2)) instance RightCoModule (->) (,) (,) ((,,,) x1 x2) + +deriving via (FromBifunctor ((,,,,) x1 x2 x3)) instance RightCoModule (->) (,) (,) ((,,,,) x1 x2 x3) + +deriving via (FromBifunctor ((,,,,,) x1 x2 x3 x4)) instance RightCoModule (->) (,) (,) ((,,,,,) x1 x2 x3 x4) + +deriving via (FromBifunctor ((,,,,,,) x1 x2 x3 x4 x5)) instance RightCoModule (->) (,) (,) ((,,,,,,) x1 x2 x3 x4 x5) + +deriving via (FromBifunctor Arg) instance RightCoModule Op Either Either Arg + +deriving via (FromBifunctor Const) instance RightCoModule Op Either Either Const + +deriving via (FromBifunctor Either) instance RightCoModule Op Either Either Either + +deriving via (FromBifunctor These) instance RightCoModule Op Either Either These + +deriving via (FromBifunctor (K1 i)) instance RightCoModule Op Either Either (K1 i :: Type -> Type -> Type) + +deriving via (FromBifunctor (,)) instance RightCoModule Op Either Either (,) + +deriving via (FromBifunctor ((,,) x1)) instance RightCoModule Op Either Either ((,,) x1) + +deriving via (FromBifunctor ((,,,) x1 x2)) instance RightCoModule Op Either Either ((,,,) x1 x2) + +deriving via (FromBifunctor ((,,,,) x1 x2 x3)) instance RightCoModule Op Either Either ((,,,,) x1 x2 x3) + +deriving via (FromBifunctor ((,,,,,) x1 x2 x3 x4)) instance RightCoModule Op Either Either ((,,,,,) x1 x2 x3 x4) + +deriving via (FromBifunctor ((,,,,,,) x1 x2 x3 x4 x5)) instance RightCoModule Op Either Either ((,,,,,,) x1 x2 x3 x4 x5) + +deriving via (FromBifunctor Arg) instance RightCoModule Op These These Arg + +deriving via (FromBifunctor Const) instance RightCoModule Op These These Const + +deriving via (FromBifunctor Either) instance RightCoModule Op These These Either + +deriving via (FromBifunctor These) instance RightCoModule Op These These These + +deriving via (FromBifunctor (K1 i)) instance RightCoModule Op These These (K1 i :: Type -> Type -> Type) + +deriving via (FromBifunctor (,)) instance RightCoModule Op These These (,) + +deriving via (FromBifunctor ((,,) x1)) instance RightCoModule Op These These ((,,) x1) + +deriving via (FromBifunctor ((,,,) x1 x2)) instance RightCoModule Op These These ((,,,) x1 x2) + +deriving via (FromBifunctor ((,,,,) x1 x2 x3)) instance RightCoModule Op These These ((,,,,) x1 x2 x3) + +deriving via (FromBifunctor ((,,,,,) x1 x2 x3 x4)) instance RightCoModule Op These These ((,,,,,) x1 x2 x3 x4) + +deriving via (FromBifunctor ((,,,,,,) x1 x2 x3 x4 x5)) instance RightCoModule Op These These ((,,,,,,) x1 x2 x3 x4 x5) + +-------------------------------------------------------------------------------- + +-- | A 'Profunctor' equipped with both a Tambara 'LeftCoModule' and +-- Tambara 'RightCoModule' is a 'CoBimodule'. +-- +-- === Laws +-- +-- @ +-- 'rcostrength' ≡ 'lcostrength' 'Control.Category..' 'Data.Profunctor.Types.dimap' 'Control.Category.Tensor.swap' 'Control.Category.Tensor.swap' +-- 'lcostrength' ≡ 'rcostrength' 'Control.Category..' 'Data.Profunctor.Types.dimap' 'Control.Category.Tensor.swap' 'Control.Category.Tensor.swap' +-- @ +class (LeftCoModule cat t1 t2 f, RightCoModule cat t1 t2 f) => CoBimodule cat t1 t2 f + +instance Costrong p => CoBimodule (->) (,) (,) (FromProfunctor p) + +instance Cochoice p => CoBimodule (->) Either Either (FromProfunctor p) + +instance Bifunctor p => CoBimodule (->) (,) (,) (FromBifunctor p) + +instance Bifunctor p => CoBimodule Op Either Either (FromBifunctor p) + +instance Bifunctor p => CoBimodule Op These These (FromBifunctor p) + +deriving via (FromProfunctor (Kleisli m)) instance MonadFix m => CoBimodule (->) (,) (,) (Kleisli m) + +deriving via (FromProfunctor Tagged) instance CoBimodule (->) (,) (,) Tagged + +deriving via (FromProfunctor (Coyoneda p)) instance Costrong p => CoBimodule (->) (,) (,) (Coyoneda p) + +deriving via (FromProfunctor (Copastro p)) instance Cochoice p => CoBimodule (->) (,) (,) (Copastro p) + +deriving via (FromProfunctor (Yoneda p)) instance Costrong p => CoBimodule (->) (,) (,) (Yoneda p) + +deriving via (FromProfunctor (->)) instance CoBimodule (->) (,) (,) (->) + +deriving via (FromProfunctor (Cokleisli f)) instance Functor f => CoBimodule (->) (,) (,) (Cokleisli f) + +deriving via (FromProfunctor (Costar f)) instance Functor f => CoBimodule (->) (,) (,) (Costar f) + +deriving via (FromProfunctor (WrappedArrow p)) instance ArrowLoop p => CoBimodule (->) (,) (,) (WrappedArrow p) + +deriving via (FromProfunctor (Sum p q)) instance (Costrong p, Costrong q) => CoBimodule (->) (,) (,) (Sum p q) + +deriving via (FromProfunctor (Product p q)) instance (Costrong p, Costrong q) => CoBimodule (->) (,) (,) (Product p q) + +deriving via (FromProfunctor (Tannen f p)) instance (Functor f, Costrong p) => CoBimodule (->) (,) (,) (Tannen f p) + +deriving via (FromProfunctor (Procompose p q)) instance (Corepresentable p, Corepresentable q) => CoBimodule (->) (,) (,) (Procompose p q) + +deriving via (FromProfunctor (Cayley f p)) instance (Functor f, Costrong p) => CoBimodule (->) (,) (,) (Cayley f p) + +deriving via (FromProfunctor (CopastroSum p)) instance CoBimodule (->) Either Either (CopastroSum p) + +deriving via (FromProfunctor (CotambaraSum p)) instance CoBimodule (->) Either Either (CotambaraSum p) + +deriving via (FromProfunctor (Coyoneda p)) instance Cochoice p => CoBimodule (->) Either Either (Coyoneda p) + +deriving via (FromProfunctor (Yoneda p)) instance Cochoice p => CoBimodule (->) Either Either (Yoneda p) + +deriving via (FromProfunctor (->)) instance CoBimodule (->) Either Either (->) + +deriving via (FromProfunctor (Forget r)) instance CoBimodule (->) Either Either (Forget r) + +deriving via (FromProfunctor (Costar f)) instance Applicative f => CoBimodule (->) Either Either (Costar f) + +deriving via (FromProfunctor (Star f)) instance Traversable f => CoBimodule (->) Either Either (Star f) + +deriving via (FromProfunctor (Sum p q)) instance (Cochoice p, Cochoice q) => CoBimodule (->) Either Either (Sum p q) + +deriving via (FromProfunctor (Product p q)) instance (Cochoice p, Cochoice q) => CoBimodule (->) Either Either (Product p q) + +deriving via (FromProfunctor (Tannen f p)) instance (Functor f, Cochoice p) => CoBimodule (->) Either Either (Tannen f p) + +deriving via (FromProfunctor (Cayley f p)) instance (Functor f, Cochoice p) => CoBimodule (->) Either Either (Cayley f p) + +deriving via (FromBifunctor Arg) instance CoBimodule (->) (,) (,) Arg + +deriving via (FromBifunctor Const) instance CoBimodule (->) (,) (,) Const + +deriving via (FromBifunctor Either) instance CoBimodule (->) (,) (,) Either + +deriving via (FromBifunctor These) instance CoBimodule (->) (,) (,) These + +deriving via (FromBifunctor (K1 i)) instance CoBimodule (->) (,) (,) (K1 i :: Type -> Type -> Type) + +deriving via (FromBifunctor (,)) instance CoBimodule (->) (,) (,) (,) + +deriving via (FromBifunctor ((,,) x1)) instance CoBimodule (->) (,) (,) ((,,) x1) + +deriving via (FromBifunctor ((,,,) x1 x2)) instance CoBimodule (->) (,) (,) ((,,,) x1 x2) + +deriving via (FromBifunctor ((,,,,) x1 x2 x3)) instance CoBimodule (->) (,) (,) ((,,,,) x1 x2 x3) + +deriving via (FromBifunctor ((,,,,,) x1 x2 x3 x4)) instance CoBimodule (->) (,) (,) ((,,,,,) x1 x2 x3 x4) + +deriving via (FromBifunctor ((,,,,,,) x1 x2 x3 x4 x5)) instance CoBimodule (->) (,) (,) ((,,,,,,) x1 x2 x3 x4 x5) + +deriving via (FromBifunctor Arg) instance CoBimodule Op Either Either Arg + +deriving via (FromBifunctor Const) instance CoBimodule Op Either Either Const + +deriving via (FromBifunctor Either) instance CoBimodule Op Either Either Either + +deriving via (FromBifunctor These) instance CoBimodule Op Either Either These + +deriving via (FromBifunctor (K1 i)) instance CoBimodule Op Either Either (K1 i :: Type -> Type -> Type) + +deriving via (FromBifunctor (,)) instance CoBimodule Op Either Either (,) + +deriving via (FromBifunctor ((,,) x1)) instance CoBimodule Op Either Either ((,,) x1) + +deriving via (FromBifunctor ((,,,) x1 x2)) instance CoBimodule Op Either Either ((,,,) x1 x2) + +deriving via (FromBifunctor ((,,,,) x1 x2 x3)) instance CoBimodule Op Either Either ((,,,,) x1 x2 x3) + +deriving via (FromBifunctor ((,,,,,) x1 x2 x3 x4)) instance CoBimodule Op Either Either ((,,,,,) x1 x2 x3 x4) + +deriving via (FromBifunctor ((,,,,,,) x1 x2 x3 x4 x5)) instance CoBimodule Op Either Either ((,,,,,,) x1 x2 x3 x4 x5) + +deriving via (FromBifunctor Arg) instance CoBimodule Op These These Arg + +deriving via (FromBifunctor Const) instance CoBimodule Op These These Const + +deriving via (FromBifunctor Either) instance CoBimodule Op These These Either + +deriving via (FromBifunctor These) instance CoBimodule Op These These These + +deriving via (FromBifunctor (K1 i)) instance CoBimodule Op These These (K1 i :: Type -> Type -> Type) + +deriving via (FromBifunctor (,)) instance CoBimodule Op These These (,) + +deriving via (FromBifunctor ((,,) x1)) instance CoBimodule Op These These ((,,) x1) + +deriving via (FromBifunctor ((,,,) x1 x2)) instance CoBimodule Op These These ((,,,) x1 x2) + +deriving via (FromBifunctor ((,,,,) x1 x2 x3)) instance CoBimodule Op These These ((,,,,) x1 x2 x3) + +deriving via (FromBifunctor ((,,,,,) x1 x2 x3 x4)) instance CoBimodule Op These These ((,,,,,) x1 x2 x3 x4) + deriving via (FromBifunctor ((,,,,,,) x1 x2 x3 x4 x5)) instance CoBimodule Op These These ((,,,,,,) x1 x2 x3 x4 x5) diff --git a/src/Data/Bifunctor/Monoidal.hs b/src/Data/Bifunctor/Monoidal.hs --- a/src/Data/Bifunctor/Monoidal.hs +++ b/src/Data/Bifunctor/Monoidal.hs @@ -13,10 +13,11 @@ -------------------------------------------------------------------------------- import Control.Applicative (Alternative (..), Applicative (..), pure, (<$>)) +import Control.Arrow (Kleisli (..)) import Control.Category (Category (..)) import Control.Category.Cartesian (Cocartesian (..), Semicartesian (..)) import Control.Category.Tensor (Associative, Iso (..), Tensor (..)) -import Control.Monad (Functor(..), Monad) +import Control.Monad (Functor (..), Monad) import Data.Biapplicative (Biapplicative (..), Bifunctor (..)) import Data.Bifunctor.Clown (Clown) import Data.Bifunctor.Joker (Joker (..)) @@ -24,7 +25,7 @@ import Data.Function (const, ($)) import Data.Profunctor (Forget (..), Profunctor (..), Star (..), Strong (..)) import Data.Semigroupoid (Semigroupoid (..)) -import Data.These (These (..)) +import Data.These (These (..), these) import Data.Tuple (fst, snd, uncurry) import Data.Void (Void, absurd) import Prelude (Either (..)) @@ -39,7 +40,7 @@ -- -- __Associativity:__ -- --- \[ +-- \[ -- \require{AMScd} -- \begin{CD} -- (F A B \bullet F C D) \bullet F X Y @>>{\alpha_{\mathcal{D}}}> F A B \bullet (F C D \bullet F X Y) \\ @@ -54,7 +55,7 @@ -- 'combine' 'Control.Category..' 'Control.Category.Tensor.grmap' 'combine' 'Control.Category..' 'bwd' 'Control.Category.Tensor.assoc' ≡ 'fmap' ('bwd' 'Control.Category.Tensor.assoc') 'Control.Category..' 'combine' 'Control.Category..' 'Control.Category.Tensor.glmap' 'combine' -- @ class (Associative cat t1, Associative cat t2, Associative cat to) => Semigroupal cat t1 t2 to f where - -- | A natural transformation \(\phi_{AB,CD} : F\ A\ B \bullet F\ C\ D \to F\ (A \otimes C)\ (B \otimes D)\). + -- | A natural transformation \(\phi_{AB,CD} : F\ A\ B \bullet F\ C\ D \to F\ (A \otimes C)\ (B \otimes D)\). -- -- ==== __Examples__ -- @@ -75,13 +76,14 @@ instance Semigroupal (->) (,) (,) (,) (,) where combine :: ((x, y), (x', y')) -> ((x, x'), (y, y')) combine ((x, y), (x', y')) = ((x, x'), (y, y')) - -- NOTE: This version could be used for a more general abstraction - -- of products in a category: - -- combine = - -- let fwd' = fwd assoc - -- bwd' = bwd assoc - -- in second swap . swap . fwd' . swap . first (bwd' . first swap) . fwd' +-- NOTE: This version could be used for a more general abstraction +-- of products in a category: +-- combine = +-- let fwd' = fwd assoc +-- bwd' = bwd assoc +-- in second swap . swap . fwd' . swap . first (bwd' . first swap) . fwd' + instance Semigroupal (->) Either Either Either (,) where combine :: Either (x, y) (x', y') -> (Either x x', Either y y') combine = either (bimap Left Left) (bimap Right Right) @@ -93,17 +95,17 @@ instance Semigroupal (->) Either (,) (,) Either where combine :: (Either x y, Either x' y') -> Either (Either x x') (y, y') combine = \case - (Left x, Left _) -> Left $ Left x - (Left x, Right _) -> Left $ Left x - (Right _, Left x') -> Left $ Right x' + (Left x, Left _) -> Left $ Left x + (Left x, Right _) -> Left $ Left x + (Right _, Left x') -> Left $ Right x' (Right y, Right y') -> Right (y, y') instance Semigroupal (->) These (,) (,) Either where combine :: (Either x y, Either x' y') -> Either (These x x') (y, y') combine = \case - (Left x, Left x') -> Left $ These x x' - (Left x, Right _) -> Left $ This x - (Right _, Left x') -> Left $ That x' + (Left x, Left x') -> Left $ These x x' + (Left x, Right _) -> Left $ This x + (Right _, Left x') -> Left $ That x' (Right y, Right y') -> Right (y, y') instance Semigroupal (->) (,) (,) (,) (->) where @@ -120,11 +122,11 @@ instance Alternative f => Semigroupal (->) Either Either (,) (Joker f) where combine :: (Joker f x y, Joker f x' y') -> Joker f (Either x x') (Either y y') - combine = uncurry $ biliftA2 (\_ x' -> Right x') (\_ y' -> Right y') + combine = uncurry $ biliftA2 (\_ x' -> Right x') (\_ y' -> Right y') instance Functor f => Semigroupal (->) Either Either Either (Joker f) where combine :: Either (Joker f x y) (Joker f x' y') -> Joker f (Either x x') (Either y y') - combine = either (Joker . fmap Left . runJoker ) (Joker . fmap Right . runJoker) + combine = either (Joker . fmap Left . runJoker) (Joker . fmap Right . runJoker) instance Applicative f => Semigroupal (->) (,) (,) (,) (Clown f) where combine :: (Clown f x y, Clown f x' y') -> Clown f (x, x') (y, y') @@ -142,16 +144,56 @@ combine :: (Star f x y, Star f x' y') -> Star f (Either x x') (Either y y') combine (Star fxy, Star fxy') = Star $ either (fmap Left . fxy) (fmap Right . fxy') +instance Applicative f => Semigroupal (->) These These (,) (Star f) where + combine :: (Star f x y, Star f x' y') -> Star f (These x x') (These y y') + combine (Star fxy, Star fxy') = Star $ these (fmap This . fxy) (fmap That . fxy') (\x x' -> liftA2 These (fxy x) (fxy' x')) + +instance Alternative f => Semigroupal (->) These These These (Star f) where + combine :: Applicative f => These (Star f x y) (Star f x' y') -> Star f (These x x') (These y y') + combine = \case + This (Star fxy) -> Star $ these (fmap This . fxy) (const empty) (\x _ -> This <$> fxy x) + That (Star fxy') -> Star $ these (const empty) (fmap That . fxy') (\_ x' -> That <$> fxy' x') + These (Star fxy) (Star fxy') -> Star $ these (fmap This . fxy) (fmap That . fxy') (\x x' -> liftA2 These (fxy x) (fxy' x')) + instance Alternative f => Semigroupal (->) Either Either Either (Star f) where combine :: Either (Star f x y) (Star f x' y') -> Star f (Either x x') (Either y y') combine = \case - Left (Star fxy) -> Star $ either (fmap Left . fxy) (const empty) + Left (Star fxy) -> Star $ either (fmap Left . fxy) (const empty) Right (Star fxy') -> Star $ either (const empty) (fmap Right . fxy') instance Alternative f => Semigroupal (->) (,) Either (,) (Star f) where combine :: (Star f x y, Star f x' y') -> Star f (x, x') (Either y y') combine (Star f, Star g) = Star $ \(x, x') -> (Left <$> f x) <|> (Right <$> g x') +instance Applicative f => Semigroupal (->) (,) (,) (,) (Kleisli f) where + combine :: (Kleisli f x y, Kleisli f x' y') -> Kleisli f (x, x') (y, y') + combine (Kleisli fxy, Kleisli fxy') = Kleisli $ \(x, x') -> liftA2 (,) (fxy x) (fxy' x') + +instance Functor f => Semigroupal (->) Either Either (,) (Kleisli f) where + combine :: (Kleisli f x y, Kleisli f x' y') -> Kleisli f (Either x x') (Either y y') + combine (Kleisli fxy, Kleisli fxy') = Kleisli $ either (fmap Left . fxy) (fmap Right . fxy') + +instance Applicative f => Semigroupal (->) These These (,) (Kleisli f) where + combine :: (Kleisli f x y, Kleisli f x' y') -> Kleisli f (These x x') (These y y') + combine (Kleisli fxy, Kleisli fxy') = Kleisli $ these (fmap This . fxy) (fmap That . fxy') (\x x' -> liftA2 These (fxy x) (fxy' x')) + +instance Alternative f => Semigroupal (->) These These These (Kleisli f) where + combine :: Applicative f => These (Kleisli f x y) (Kleisli f x' y') -> Kleisli f (These x x') (These y y') + combine = \case + This (Kleisli fxy) -> Kleisli $ these (fmap This . fxy) (const empty) (\x _ -> This <$> fxy x) + That (Kleisli fxy') -> Kleisli $ these (const empty) (fmap That . fxy') (\_ x' -> That <$> fxy' x') + These (Kleisli fxy) (Kleisli fxy') -> Kleisli $ these (fmap This . fxy) (fmap That . fxy') (\x x' -> liftA2 These (fxy x) (fxy' x')) + +instance Alternative f => Semigroupal (->) Either Either Either (Kleisli f) where + combine :: Either (Kleisli f x y) (Kleisli f x' y') -> Kleisli f (Either x x') (Either y y') + combine = \case + Left (Kleisli fxy) -> Kleisli $ either (fmap Left . fxy) (const empty) + Right (Kleisli fxy') -> Kleisli $ either (const empty) (fmap Right . fxy') + +instance Alternative f => Semigroupal (->) (,) Either (,) (Kleisli f) where + combine :: (Kleisli f x y, Kleisli f x' y') -> Kleisli f (x, x') (Either y y') + combine (Kleisli f, Kleisli g) = Kleisli $ \(x, x') -> (Left <$> f x) <|> (Right <$> g x') + instance Alternative f => Semigroupal (->) (,) (,) (,) (Forget (f r)) where combine :: (Forget (f r) x y, Forget (f r) x' y') -> Forget (f r) (x, x') (y, y') combine (Forget f, Forget g) = Forget $ \(x, x') -> f x <|> g x' @@ -163,7 +205,7 @@ instance Alternative f => Semigroupal (->) Either Either Either (Forget (f r)) where combine :: Either (Forget (f r) x y) (Forget (f r) x' y') -> Forget (f r) (Either x x') (Either y y') combine = \case - Left (Forget f) -> Forget $ either f (const empty) + Left (Forget f) -> Forget $ either f (const empty) Right (Forget g) -> Forget $ either (const empty) g instance Alternative f => Semigroupal (->) (,) Either (,) (Forget (f r)) where @@ -186,7 +228,7 @@ -- -- >>> :t introduce @(->) @Void @() @() @Either -- introduce @(->) @Void @() @() @Either :: () -> Either Void () - -- + -- -- >>> introduce @(->) @Void @() @() @Either () -- Right () introduce :: cat io (f i1 i2) @@ -251,6 +293,22 @@ introduce :: () -> Star f () Void introduce () = Star $ const empty +instance Applicative f => Unital (->) () () () (Kleisli f) where + introduce :: () -> Kleisli f () () + introduce () = Kleisli pure + +instance Unital (->) Void Void () (Kleisli f) where + introduce :: () -> Kleisli f Void Void + introduce () = Kleisli absurd + +instance Alternative f => Unital (->) Void Void Void (Kleisli f) where + introduce :: Void -> Kleisli f Void Void + introduce = absurd + +instance Alternative f => Unital (->) () Void () (Kleisli f) where + introduce :: () -> Kleisli f () Void + introduce () = Kleisli $ const empty + -------------------------------------------------------------------------------- -- Monoidal @@ -264,7 +322,7 @@ -- -- __Right Unitality:__ -- --- \[ +-- \[ -- \require{AMScd} -- \begin{CD} -- F A B \bullet I_{\mathcal{D}} @>{1 \bullet \phi}>> F A B \bullet F I_{\mathcal{C_{1}}} I_{\mathcal{C_{2}}}\\ @@ -279,7 +337,7 @@ -- -- __ Left Unitality__: -- --- \[ +-- \[ -- \begin{CD} -- I_{\mathcal{D}} \bullet F A B @>{\phi \bullet 1}>> F I_{\mathcal{C_{1}}} I_{\mathcal{C_{2}}} \bullet F A B\\ -- @VV{\lambda_{\mathcal{D}}}V @VV{I_{\mathcal{C_{1}}}I_{\mathcal{C_{2}}},\phi AB}V \\ @@ -290,28 +348,60 @@ -- @ -- 'combine' 'Control.Category..' 'Control.Category.Tensor.glmap' 'introduce' ≡ 'fmap' ('bwd' 'unitl') 'Control.Category..' 'fwd' 'unitl' -- @ -class ( Tensor cat t1 i1 - , Tensor cat t2 i2 - , Tensor cat to io - , Semigroupal cat t1 t2 to f - , Unital cat i1 i2 io f - ) => Monoidal cat t1 i1 t2 i2 to io f +class + ( Tensor cat t1 i1, + Tensor cat t2 i2, + Tensor cat to io, + Semigroupal cat t1 t2 to f, + Unital cat i1 i2 io f + ) => + Monoidal cat t1 i1 t2 i2 to io f instance (Strong p, Semigroupoid p, Category p) => Monoidal (->) (,) () (,) () (,) () (StrongCategory p) + instance Monoidal (->) (,) () (,) () (,) () (,) + instance Monoidal (->) Either Void Either Void Either Void (,) + instance Monoidal (->) Either Void Either Void Either Void Either + instance Monoidal (->) Either Void (,) () (,) () Either + instance Monoidal (->) These Void (,) () (,) () Either + instance Monoidal (->) (,) () (,) () (,) () (->) + instance Monoidal (->) Either Void Either Void (,) () (->) + instance Applicative f => Monoidal (->) (,) () (,) () (,) () (Joker f) + instance Alternative f => Monoidal (->) Either Void Either Void (,) () (Joker f) + instance Functor f => Monoidal (->) Either Void Either Void Either Void (Joker f) + instance Applicative f => Monoidal (->) (,) () (,) () (,) () (Star f) + instance Functor f => Monoidal (->) Either Void Either Void (,) () (Star f) + +instance Applicative f => Monoidal (->) These Void These Void (,) () (Star f) + instance Alternative f => Monoidal (->) Either Void Either Void Either Void (Star f) + +instance Alternative f => Monoidal (->) These Void These Void These Void (Star f) + instance Alternative f => Monoidal (->) (,) () Either Void (,) () (Star f) + +instance Applicative f => Monoidal (->) (,) () (,) () (,) () (Kleisli f) + +instance Functor f => Monoidal (->) Either Void Either Void (,) () (Kleisli f) + +instance Applicative f => Monoidal (->) These Void These Void (,) () (Kleisli f) + +instance Alternative f => Monoidal (->) Either Void Either Void Either Void (Kleisli f) + +instance Alternative f => Monoidal (->) These Void These Void These Void (Kleisli f) + +instance Alternative f => Monoidal (->) (,) () Either Void (,) () (Kleisli f) newtype StrongCategory p a b = StrongCategory (p a b) deriving (Functor, Applicative, Monad, Profunctor, Category) diff --git a/src/Data/Bifunctor/Monoidal/Specialized.hs b/src/Data/Bifunctor/Monoidal/Specialized.hs --- a/src/Data/Bifunctor/Monoidal/Specialized.hs +++ b/src/Data/Bifunctor/Monoidal/Specialized.hs @@ -1,16 +1,17 @@ {-# LANGUAGE TupleSections #-} -module Data.Bifunctor.Monoidal.Specialized where -import Prelude hiding ((&&), (||)) +module Data.Bifunctor.Monoidal.Specialized where import Control.Category.Cartesian import Control.Category.Tensor () import Data.Bifunctor.Monoidal import Data.Functor.Contravariant import Data.Profunctor +import Data.These import Data.Void +import Prelude hiding ((&&), (||)) --- | Split the input between the two argument arrows and multiply their outputs. +-- | Split the input between the two arguments and multiply their outputs. mux :: Semigroupal (->) (,) (,) (,) p => p a b -> p c d -> p (a, c) (b, d) mux = curry combine @@ -20,7 +21,7 @@ (***) :: Semigroupal (->) (,) (,) (,) p => p a b -> p c d -> p (a, c) (b, d) (***) = mux --- | Split the input between the two argument arrows and sum their outputs. +-- | Split the input between the two arguments and sum their outputs. demux :: Semigroupal (->) Either Either (,) p => p a b -> p c d -> p (Either a c) (Either b d) demux = curry combine @@ -30,7 +31,7 @@ (+++) :: Semigroupal (->) Either Either (,) p => p a b -> p c d -> p (Either a c) (Either b d) (+++) = demux --- | Send the whole input to the two argument arrows and multiply their outputs. +-- | Send the whole input to the two arguments and multiply their outputs. fanout :: (Profunctor p, Semigroupal (->) (,) (,) (,) p) => p x a -> p x b -> p x (a, b) fanout pxa pxb = lmap split' $ pxa *** pxb @@ -40,7 +41,7 @@ (&&&) :: (Profunctor p, Semigroupal (->) (,) (,) (,) p) => p x a -> p x b -> p x (a, b) (&&&) = fanout --- | Split the input between the two argument arrows and merge their outputs. +-- | Split the input between the two arguments and merge their outputs. fanin :: (Profunctor p, Semigroupal (->) Either Either (,) p) => p a x -> p b x -> p (Either a b) x fanin pax pbx = rmap merge' $ pax +++ pbx @@ -49,8 +50,8 @@ -- | Infix operator for 'fanin'. (|||) :: (Profunctor p, Semigroupal (->) Either Either (,) p) => p a x -> p b x -> p (Either a b) x (|||) = fanin - --- | Split the input between the two argument arrows and and sum their outputs. + +-- | Split the input between the two arguments and and sum their outputs. switch :: Semigroupal (->) (,) Either (,) p => p a b -> p c d -> p (a, c) (Either b d) switch = curry combine @@ -60,15 +61,15 @@ (&|) :: Semigroupal (->) (,) Either (,) p => p a b -> p c d -> p (a, c) (Either b d) (&|) = switch --- | Send the whole input to the two argument arrows and sum their outputs. +-- | Send the whole input to the two arguments and sum their outputs. union :: Profunctor p => Semigroupal (->) (,) Either (,) p => p x a -> p x b -> p x (Either a b) union pxa pxb = lmap split' $ pxa &| pxb --- | Split the input between the two argument arrows then merge their outputs. +-- | Split the input between the two arguments then merge their outputs. divide :: (Profunctor p, Semigroupal (->) (,) Either (,) p) => p a x -> p b x -> p (a, b) x divide pxa pxb = rmap merge' $ pxa &| pxb --- | Split the input between the two argument arrows then multiply their outputs. +-- | Split the input between the two arguments then multiply their outputs. splice :: Semigroupal (->) Either (,) (,) p => p a b -> p c d -> p (Either a c) (b, d) splice = curry combine diff --git a/src/Data/Functor/Invariant.hs b/src/Data/Functor/Invariant.hs --- a/src/Data/Functor/Invariant.hs +++ b/src/Data/Functor/Invariant.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DefaultSignatures #-} + module Data.Functor.Invariant ( -- * Invariant Invariant (..), @@ -45,9 +46,9 @@ invmap = invmapFunctor invIso :: Invariant f => Iso (->) a a' -> Iso (->) (f a) (f a') -invIso (Iso f g) = Iso (invmap f g) (invmap g f) +invIso (Iso f g) = Iso (invmap f g) (invmap g f) -newtype FromFunctor f a = FromFunctor { runBi :: f a } +newtype FromFunctor f a = FromFunctor {runBi :: f a} -- | Every 'Functor' is also an 'Invariant' functor. invmapFunctor :: Functor f => (a -> b) -> (b -> a) -> f a -> f b @@ -57,22 +58,34 @@ invmap :: (a -> a') -> (a' -> a) -> FromFunctor f a -> FromFunctor f a' invmap f _ = FromFunctor . fmap f . runBi -newtype FromContra f a = FromContra { runContra :: f a } +newtype FromContra f a = FromContra {runContra :: f a} instance Contravariant f => Invariant (FromContra f) where invmap :: (a -> a') -> (a' -> a) -> FromContra f a -> FromContra f a' invmap _ g = FromContra . contramap g . runContra -deriving via FromFunctor Identity instance Invariant Identity -deriving via FromFunctor (Compose f g) instance (Functor f, Functor g) => Invariant (Compose f g) -deriving via FromFunctor [] instance Invariant [] -deriving via FromFunctor ZipList instance Invariant ZipList -deriving via FromFunctor NonEmpty instance Invariant NonEmpty -deriving via FromFunctor Maybe instance Invariant Maybe -deriving via FromFunctor (Either e) instance Invariant (Either e) -deriving via FromFunctor IO instance Invariant IO -deriving via FromFunctor (Sum f g) instance (Functor f, Functor g) => Invariant (Sum f g) -deriving via FromFunctor (Product f g) instance (Functor f, Functor g) => Invariant (Product f g) -deriving via (FromFunctor ((,) x1)) instance Invariant ((,) x1) -deriving via (FromFunctor ((,,) x1 x2)) instance Invariant ((,,) x1 x2) +deriving via FromFunctor Identity instance Invariant Identity + +deriving via FromFunctor (Compose f g) instance (Functor f, Functor g) => Invariant (Compose f g) + +deriving via FromFunctor [] instance Invariant [] + +deriving via FromFunctor ZipList instance Invariant ZipList + +deriving via FromFunctor NonEmpty instance Invariant NonEmpty + +deriving via FromFunctor Maybe instance Invariant Maybe + +deriving via FromFunctor (Either e) instance Invariant (Either e) + +deriving via FromFunctor IO instance Invariant IO + +deriving via FromFunctor (Sum f g) instance (Functor f, Functor g) => Invariant (Sum f g) + +deriving via FromFunctor (Product f g) instance (Functor f, Functor g) => Invariant (Product f g) + +deriving via (FromFunctor ((,) x1)) instance Invariant ((,) x1) + +deriving via (FromFunctor ((,,) x1 x2)) instance Invariant ((,,) x1 x2) + deriving via (FromFunctor ((,,,) x1 x2 x3)) instance Invariant ((,,,) x1 x2 x3) diff --git a/src/Data/Functor/Module.hs b/src/Data/Functor/Module.hs --- a/src/Data/Functor/Module.hs +++ b/src/Data/Functor/Module.hs @@ -46,7 +46,7 @@ -- >>> :t lstrength @(->) @(,) @Predicate (Predicate @Int (> 10)) -- lstrength @(->) @(,) @Predicate (Predicate @Int (> 10)) :: Predicate (Int, x) -- - -- >>> :t lstrength @(->) @Either @[] + -- >>> :t lstrength @(->) @Either @[] -- lstrength @(->) @Either @[] :: a -> [Either a x] -- -- >>> lstrength @(->) @Either @[] [True, False] @@ -71,86 +71,158 @@ instance Functor f => LeftModule Op (,) (FromFunctor f) where lstrength = Op (fmap fst) -deriving via (FromContra Comparison) instance LeftModule (->) (,) Comparison -deriving via (FromContra Equivalence) instance LeftModule (->) (,) Equivalence -deriving via (FromContra Predicate) instance LeftModule (->) (,) Predicate -deriving via (FromContra (Op a)) instance LeftModule (->) (,) (Op a) -deriving via (FromContra Proxy) instance LeftModule (->) (,) Proxy -deriving via (FromContra U1) instance LeftModule (->) (,) U1 -deriving via (FromContra V1) instance LeftModule (->) (,) V1 -deriving via (FromContra (Const a)) instance LeftModule (->) (,) (Const a) -deriving via (FromContra (Alt f)) instance Contravariant f => LeftModule (->) (,) (Alt f) -deriving via (FromContra (Rec1 f)) instance Contravariant f => LeftModule (->) (,) (Rec1 f) +deriving via (FromContra Comparison) instance LeftModule (->) (,) Comparison + +deriving via (FromContra Equivalence) instance LeftModule (->) (,) Equivalence + +deriving via (FromContra Predicate) instance LeftModule (->) (,) Predicate + +deriving via (FromContra (Op a)) instance LeftModule (->) (,) (Op a) + +deriving via (FromContra Proxy) instance LeftModule (->) (,) Proxy + +deriving via (FromContra U1) instance LeftModule (->) (,) U1 + +deriving via (FromContra V1) instance LeftModule (->) (,) V1 + +deriving via (FromContra (Const a)) instance LeftModule (->) (,) (Const a) + +deriving via (FromContra (Alt f)) instance Contravariant f => LeftModule (->) (,) (Alt f) + +deriving via (FromContra (Rec1 f)) instance Contravariant f => LeftModule (->) (,) (Rec1 f) + deriving via (FromContra (Product f g)) instance (Contravariant f, Contravariant g) => LeftModule (->) (,) (Product f g) -deriving via (FromContra (Sum f g)) instance (Contravariant f, Contravariant g) => LeftModule (->) (,) (Sum f g) -deriving via (FromContra (f :+: g)) instance (Contravariant f, Contravariant g) => LeftModule (->) (,) (f :+: g) -deriving via (FromContra (f :*: g)) instance (Contravariant f, Contravariant g) => LeftModule (->) (,) (f :*: g) -deriving via (FromContra (K1 i c)) instance LeftModule (->) (,) (K1 i c) + +deriving via (FromContra (Sum f g)) instance (Contravariant f, Contravariant g) => LeftModule (->) (,) (Sum f g) + +deriving via (FromContra (f :+: g)) instance (Contravariant f, Contravariant g) => LeftModule (->) (,) (f :+: g) + +deriving via (FromContra (f :*: g)) instance (Contravariant f, Contravariant g) => LeftModule (->) (,) (f :*: g) + +deriving via (FromContra (K1 i c)) instance LeftModule (->) (,) (K1 i c) + deriving via (FromContra (Compose f g)) instance (Functor f, Contravariant g) => LeftModule (->) (,) (Compose f g) -deriving via (FromContra (f :.: g)) instance (Functor f, Contravariant g) => LeftModule (->) (,) (f :.: g) -deriving via (FromContra (M1 i c f)) instance Contravariant f => LeftModule (->) (,) (M1 i c f) -deriving via (FromContra Comparison) instance LeftModule Op Either Comparison -deriving via (FromContra Equivalence) instance LeftModule Op Either Equivalence -deriving via (FromContra Predicate) instance LeftModule Op Either Predicate -deriving via (FromContra (Op a)) instance LeftModule Op Either (Op a) -deriving via (FromContra Proxy) instance LeftModule Op Either Proxy -deriving via (FromContra U1) instance LeftModule Op Either U1 -deriving via (FromContra V1) instance LeftModule Op Either V1 -deriving via (FromContra (Const a)) instance LeftModule Op Either (Const a) -deriving via (FromContra (Alt f)) instance Contravariant f => LeftModule Op Either (Alt f) -deriving via (FromContra (Rec1 f)) instance Contravariant f => LeftModule Op Either (Rec1 f) +deriving via (FromContra (f :.: g)) instance (Functor f, Contravariant g) => LeftModule (->) (,) (f :.: g) + +deriving via (FromContra (M1 i c f)) instance Contravariant f => LeftModule (->) (,) (M1 i c f) + +deriving via (FromContra Comparison) instance LeftModule Op Either Comparison + +deriving via (FromContra Equivalence) instance LeftModule Op Either Equivalence + +deriving via (FromContra Predicate) instance LeftModule Op Either Predicate + +deriving via (FromContra (Op a)) instance LeftModule Op Either (Op a) + +deriving via (FromContra Proxy) instance LeftModule Op Either Proxy + +deriving via (FromContra U1) instance LeftModule Op Either U1 + +deriving via (FromContra V1) instance LeftModule Op Either V1 + +deriving via (FromContra (Const a)) instance LeftModule Op Either (Const a) + +deriving via (FromContra (Alt f)) instance Contravariant f => LeftModule Op Either (Alt f) + +deriving via (FromContra (Rec1 f)) instance Contravariant f => LeftModule Op Either (Rec1 f) + deriving via (FromContra (Product f g)) instance (Contravariant f, Contravariant g) => LeftModule Op Either (Product f g) -deriving via (FromContra (Sum f g)) instance (Contravariant f, Contravariant g) => LeftModule Op Either (Sum f g) -deriving via (FromContra (f :+: g)) instance (Contravariant f, Contravariant g) => LeftModule Op Either (f :+: g) -deriving via (FromContra (f :*: g)) instance (Contravariant f, Contravariant g) => LeftModule Op Either (f :*: g) -deriving via (FromContra (K1 i c)) instance LeftModule Op Either (K1 i c) + +deriving via (FromContra (Sum f g)) instance (Contravariant f, Contravariant g) => LeftModule Op Either (Sum f g) + +deriving via (FromContra (f :+: g)) instance (Contravariant f, Contravariant g) => LeftModule Op Either (f :+: g) + +deriving via (FromContra (f :*: g)) instance (Contravariant f, Contravariant g) => LeftModule Op Either (f :*: g) + +deriving via (FromContra (K1 i c)) instance LeftModule Op Either (K1 i c) + deriving via (FromContra (Compose f g)) instance (Functor f, Contravariant g) => LeftModule Op Either (Compose f g) -deriving via (FromContra (f :.: g)) instance (Functor f, Contravariant g) => LeftModule Op Either (f :.: g) -deriving via (FromContra (M1 i c f)) instance Contravariant f => LeftModule Op Either (M1 i c f) -deriving via FromFunctor Identity instance LeftModule (->) Either Identity -deriving via FromFunctor (Compose f g) instance (Functor f, Functor g) => LeftModule (->) Either (Compose f g) -deriving via FromFunctor [] instance LeftModule (->) Either [] -deriving via FromFunctor ZipList instance LeftModule (->) Either ZipList -deriving via FromFunctor NonEmpty instance LeftModule (->) Either NonEmpty -deriving via FromFunctor Maybe instance LeftModule (->) Either Maybe -deriving via FromFunctor (Either e) instance LeftModule (->) Either (Either e) -deriving via FromFunctor (These a) instance LeftModule (->) Either (These a) -deriving via FromFunctor IO instance LeftModule (->) Either IO -deriving via FromFunctor (Sum f g) instance (Functor f, Functor g) => LeftModule (->) Either (Sum f g) -deriving via FromFunctor (Product f g) instance (Functor f, Functor g) => LeftModule (->) Either (Product f g) -deriving via (FromFunctor ((,) x1)) instance LeftModule (->) Either ((,) x1) -deriving via (FromFunctor ((,,) x1 x2)) instance LeftModule (->) Either ((,,) x1 x2) +deriving via (FromContra (f :.: g)) instance (Functor f, Contravariant g) => LeftModule Op Either (f :.: g) + +deriving via (FromContra (M1 i c f)) instance Contravariant f => LeftModule Op Either (M1 i c f) + +deriving via FromFunctor Identity instance LeftModule (->) Either Identity + +deriving via FromFunctor (Compose f g) instance (Functor f, Functor g) => LeftModule (->) Either (Compose f g) + +deriving via FromFunctor [] instance LeftModule (->) Either [] + +deriving via FromFunctor ZipList instance LeftModule (->) Either ZipList + +deriving via FromFunctor NonEmpty instance LeftModule (->) Either NonEmpty + +deriving via FromFunctor Maybe instance LeftModule (->) Either Maybe + +deriving via FromFunctor (Either e) instance LeftModule (->) Either (Either e) + +deriving via FromFunctor (These a) instance LeftModule (->) Either (These a) + +deriving via FromFunctor IO instance LeftModule (->) Either IO + +deriving via FromFunctor (Sum f g) instance (Functor f, Functor g) => LeftModule (->) Either (Sum f g) + +deriving via FromFunctor (Product f g) instance (Functor f, Functor g) => LeftModule (->) Either (Product f g) + +deriving via (FromFunctor ((,) x1)) instance LeftModule (->) Either ((,) x1) + +deriving via (FromFunctor ((,,) x1 x2)) instance LeftModule (->) Either ((,,) x1 x2) + deriving via (FromFunctor ((,,,) x1 x2 x3)) instance LeftModule (->) Either ((,,,) x1 x2 x3) -deriving via FromFunctor Identity instance LeftModule (->) These Identity -deriving via FromFunctor (Compose f g) instance (Functor f, Functor g) => LeftModule (->) These (Compose f g) -deriving via FromFunctor [] instance LeftModule (->) These [] -deriving via FromFunctor ZipList instance LeftModule (->) These ZipList -deriving via FromFunctor NonEmpty instance LeftModule (->) These NonEmpty -deriving via FromFunctor Maybe instance LeftModule (->) These Maybe -deriving via FromFunctor (Either e) instance LeftModule (->) These (Either e) -deriving via FromFunctor (These a) instance LeftModule (->) These (These a) -deriving via FromFunctor IO instance LeftModule (->) These IO -deriving via FromFunctor (Sum f g) instance (Functor f, Functor g) => LeftModule (->) These (Sum f g) -deriving via FromFunctor (Product f g) instance (Functor f, Functor g) => LeftModule (->) These (Product f g) -deriving via (FromFunctor ((,) x1)) instance LeftModule (->) These ((,) x1) -deriving via (FromFunctor ((,,) x1 x2)) instance LeftModule (->) These ((,,) x1 x2) +deriving via FromFunctor Identity instance LeftModule (->) These Identity + +deriving via FromFunctor (Compose f g) instance (Functor f, Functor g) => LeftModule (->) These (Compose f g) + +deriving via FromFunctor [] instance LeftModule (->) These [] + +deriving via FromFunctor ZipList instance LeftModule (->) These ZipList + +deriving via FromFunctor NonEmpty instance LeftModule (->) These NonEmpty + +deriving via FromFunctor Maybe instance LeftModule (->) These Maybe + +deriving via FromFunctor (Either e) instance LeftModule (->) These (Either e) + +deriving via FromFunctor (These a) instance LeftModule (->) These (These a) + +deriving via FromFunctor IO instance LeftModule (->) These IO + +deriving via FromFunctor (Sum f g) instance (Functor f, Functor g) => LeftModule (->) These (Sum f g) + +deriving via FromFunctor (Product f g) instance (Functor f, Functor g) => LeftModule (->) These (Product f g) + +deriving via (FromFunctor ((,) x1)) instance LeftModule (->) These ((,) x1) + +deriving via (FromFunctor ((,,) x1 x2)) instance LeftModule (->) These ((,,) x1 x2) + deriving via (FromFunctor ((,,,) x1 x2 x3)) instance LeftModule (->) These ((,,,) x1 x2 x3) -deriving via FromFunctor Identity instance LeftModule Op (,) Identity -deriving via FromFunctor (Compose f g) instance (Functor f, Functor g) => LeftModule Op (,) (Compose f g) -deriving via FromFunctor [] instance LeftModule Op (,) [] -deriving via FromFunctor ZipList instance LeftModule Op (,) ZipList -deriving via FromFunctor NonEmpty instance LeftModule Op (,) NonEmpty -deriving via FromFunctor Maybe instance LeftModule Op (,) Maybe -deriving via FromFunctor (Either e) instance LeftModule Op (,) (Either e) -deriving via FromFunctor IO instance LeftModule Op (,) IO -deriving via FromFunctor (Sum f g) instance (Functor f, Functor g) => LeftModule Op (,) (Sum f g) -deriving via FromFunctor (Product f g) instance (Functor f, Functor g) => LeftModule Op (,) (Product f g) -deriving via (FromFunctor ((,) x1)) instance LeftModule Op (,) ((,) x1) -deriving via (FromFunctor ((,,) x1 x2)) instance LeftModule Op (,) ((,,) x1 x2) +deriving via FromFunctor Identity instance LeftModule Op (,) Identity + +deriving via FromFunctor (Compose f g) instance (Functor f, Functor g) => LeftModule Op (,) (Compose f g) + +deriving via FromFunctor [] instance LeftModule Op (,) [] + +deriving via FromFunctor ZipList instance LeftModule Op (,) ZipList + +deriving via FromFunctor NonEmpty instance LeftModule Op (,) NonEmpty + +deriving via FromFunctor Maybe instance LeftModule Op (,) Maybe + +deriving via FromFunctor (Either e) instance LeftModule Op (,) (Either e) + +deriving via FromFunctor IO instance LeftModule Op (,) IO + +deriving via FromFunctor (Sum f g) instance (Functor f, Functor g) => LeftModule Op (,) (Sum f g) + +deriving via FromFunctor (Product f g) instance (Functor f, Functor g) => LeftModule Op (,) (Product f g) + +deriving via (FromFunctor ((,) x1)) instance LeftModule Op (,) ((,) x1) + +deriving via (FromFunctor ((,,) x1 x2)) instance LeftModule Op (,) ((,,) x1 x2) + deriving via (FromFunctor ((,,,) x1 x2 x3)) instance LeftModule Op (,) ((,,,) x1 x2 x3) -------------------------------------------------------------------------------- @@ -161,7 +233,7 @@ -- >>> :t rstrength @(->) @(,) @Predicate (Predicate @Int (> 10)) -- rstrength @(->) @(,) @Predicate (Predicate @Int (> 10)) :: Predicate (x, Int) -- - -- >>> :t rstrength @(->) @Either @[] + -- >>> :t rstrength @(->) @Either @[] -- rstrength @(->) @Either @[] :: [a] -> [Either x a] -- >>> rstrength @(->) @Either @[] [True, False] -- [Right True,Right False] @@ -187,176 +259,324 @@ rstrength :: Op (FromFunctor f a) (FromFunctor f (x, a)) rstrength = Op (fmap snd) -deriving via (FromContra Comparison) instance RightModule (->) (,) Comparison -deriving via (FromContra Equivalence) instance RightModule (->) (,) Equivalence -deriving via (FromContra Predicate) instance RightModule (->) (,) Predicate -deriving via (FromContra (Op a)) instance RightModule (->) (,) (Op a) -deriving via (FromContra Proxy) instance RightModule (->) (,) Proxy -deriving via (FromContra U1) instance RightModule (->) (,) U1 -deriving via (FromContra V1) instance RightModule (->) (,) V1 -deriving via (FromContra (Const a)) instance RightModule (->) (,) (Const a) -deriving via (FromContra (Alt f)) instance Contravariant f => RightModule (->) (,) (Alt f) -deriving via (FromContra (Rec1 f)) instance Contravariant f => RightModule (->) (,) (Rec1 f) +deriving via (FromContra Comparison) instance RightModule (->) (,) Comparison + +deriving via (FromContra Equivalence) instance RightModule (->) (,) Equivalence + +deriving via (FromContra Predicate) instance RightModule (->) (,) Predicate + +deriving via (FromContra (Op a)) instance RightModule (->) (,) (Op a) + +deriving via (FromContra Proxy) instance RightModule (->) (,) Proxy + +deriving via (FromContra U1) instance RightModule (->) (,) U1 + +deriving via (FromContra V1) instance RightModule (->) (,) V1 + +deriving via (FromContra (Const a)) instance RightModule (->) (,) (Const a) + +deriving via (FromContra (Alt f)) instance Contravariant f => RightModule (->) (,) (Alt f) + +deriving via (FromContra (Rec1 f)) instance Contravariant f => RightModule (->) (,) (Rec1 f) + deriving via (FromContra (Product f g)) instance (Contravariant f, Contravariant g) => RightModule (->) (,) (Product f g) -deriving via (FromContra (Sum f g)) instance (Contravariant f, Contravariant g) => RightModule (->) (,) (Sum f g) -deriving via (FromContra (f :+: g)) instance (Contravariant f, Contravariant g) => RightModule (->) (,) (f :+: g) -deriving via (FromContra (f :*: g)) instance (Contravariant f, Contravariant g) => RightModule (->) (,) (f :*: g) -deriving via (FromContra (K1 i c)) instance RightModule (->) (,) (K1 i c) + +deriving via (FromContra (Sum f g)) instance (Contravariant f, Contravariant g) => RightModule (->) (,) (Sum f g) + +deriving via (FromContra (f :+: g)) instance (Contravariant f, Contravariant g) => RightModule (->) (,) (f :+: g) + +deriving via (FromContra (f :*: g)) instance (Contravariant f, Contravariant g) => RightModule (->) (,) (f :*: g) + +deriving via (FromContra (K1 i c)) instance RightModule (->) (,) (K1 i c) + deriving via (FromContra (Compose f g)) instance (Functor f, Contravariant g) => RightModule (->) (,) (Compose f g) -deriving via (FromContra (f :.: g)) instance (Functor f, Contravariant g) => RightModule (->) (,) (f :.: g) -deriving via (FromContra (M1 i c f)) instance Contravariant f => RightModule (->) (,) (M1 i c f) -deriving via (FromContra Comparison) instance RightModule Op Either Comparison -deriving via (FromContra Equivalence) instance RightModule Op Either Equivalence -deriving via (FromContra Predicate) instance RightModule Op Either Predicate -deriving via (FromContra (Op a)) instance RightModule Op Either (Op a) -deriving via (FromContra Proxy) instance RightModule Op Either Proxy -deriving via (FromContra U1) instance RightModule Op Either U1 -deriving via (FromContra V1) instance RightModule Op Either V1 -deriving via (FromContra (Const a)) instance RightModule Op Either (Const a) -deriving via (FromContra (Alt f)) instance Contravariant f => RightModule Op Either (Alt f) -deriving via (FromContra (Rec1 f)) instance Contravariant f => RightModule Op Either (Rec1 f) +deriving via (FromContra (f :.: g)) instance (Functor f, Contravariant g) => RightModule (->) (,) (f :.: g) + +deriving via (FromContra (M1 i c f)) instance Contravariant f => RightModule (->) (,) (M1 i c f) + +deriving via (FromContra Comparison) instance RightModule Op Either Comparison + +deriving via (FromContra Equivalence) instance RightModule Op Either Equivalence + +deriving via (FromContra Predicate) instance RightModule Op Either Predicate + +deriving via (FromContra (Op a)) instance RightModule Op Either (Op a) + +deriving via (FromContra Proxy) instance RightModule Op Either Proxy + +deriving via (FromContra U1) instance RightModule Op Either U1 + +deriving via (FromContra V1) instance RightModule Op Either V1 + +deriving via (FromContra (Const a)) instance RightModule Op Either (Const a) + +deriving via (FromContra (Alt f)) instance Contravariant f => RightModule Op Either (Alt f) + +deriving via (FromContra (Rec1 f)) instance Contravariant f => RightModule Op Either (Rec1 f) + deriving via (FromContra (Product f g)) instance (Contravariant f, Contravariant g) => RightModule Op Either (Product f g) -deriving via (FromContra (Sum f g)) instance (Contravariant f, Contravariant g) => RightModule Op Either (Sum f g) -deriving via (FromContra (f :+: g)) instance (Contravariant f, Contravariant g) => RightModule Op Either (f :+: g) -deriving via (FromContra (f :*: g)) instance (Contravariant f, Contravariant g) => RightModule Op Either (f :*: g) -deriving via (FromContra (K1 i c)) instance RightModule Op Either (K1 i c) + +deriving via (FromContra (Sum f g)) instance (Contravariant f, Contravariant g) => RightModule Op Either (Sum f g) + +deriving via (FromContra (f :+: g)) instance (Contravariant f, Contravariant g) => RightModule Op Either (f :+: g) + +deriving via (FromContra (f :*: g)) instance (Contravariant f, Contravariant g) => RightModule Op Either (f :*: g) + +deriving via (FromContra (K1 i c)) instance RightModule Op Either (K1 i c) + deriving via (FromContra (Compose f g)) instance (Functor f, Contravariant g) => RightModule Op Either (Compose f g) -deriving via (FromContra (f :.: g)) instance (Functor f, Contravariant g) => RightModule Op Either (f :.: g) -deriving via (FromContra (M1 i c f)) instance Contravariant f => RightModule Op Either (M1 i c f) -deriving via FromFunctor Identity instance RightModule (->) Either Identity -deriving via FromFunctor (Compose f g) instance (Functor f, Functor g) => RightModule (->) Either (Compose f g) -deriving via FromFunctor [] instance RightModule (->) Either [] -deriving via FromFunctor ZipList instance RightModule (->) Either ZipList -deriving via FromFunctor NonEmpty instance RightModule (->) Either NonEmpty -deriving via FromFunctor Maybe instance RightModule (->) Either Maybe -deriving via FromFunctor (Either e) instance RightModule (->) Either (Either e) -deriving via FromFunctor (These a) instance RightModule (->) Either (These a) -deriving via FromFunctor IO instance RightModule (->) Either IO -deriving via FromFunctor (Sum f g) instance (Functor f, Functor g) => RightModule (->) Either (Sum f g) -deriving via FromFunctor (Product f g) instance (Functor f, Functor g) => RightModule (->) Either (Product f g) -deriving via (FromFunctor ((,) x1)) instance RightModule (->) Either ((,) x1) -deriving via (FromFunctor ((,,) x1 x2)) instance RightModule (->) Either ((,,) x1 x2) +deriving via (FromContra (f :.: g)) instance (Functor f, Contravariant g) => RightModule Op Either (f :.: g) + +deriving via (FromContra (M1 i c f)) instance Contravariant f => RightModule Op Either (M1 i c f) + +deriving via FromFunctor Identity instance RightModule (->) Either Identity + +deriving via FromFunctor (Compose f g) instance (Functor f, Functor g) => RightModule (->) Either (Compose f g) + +deriving via FromFunctor [] instance RightModule (->) Either [] + +deriving via FromFunctor ZipList instance RightModule (->) Either ZipList + +deriving via FromFunctor NonEmpty instance RightModule (->) Either NonEmpty + +deriving via FromFunctor Maybe instance RightModule (->) Either Maybe + +deriving via FromFunctor (Either e) instance RightModule (->) Either (Either e) + +deriving via FromFunctor (These a) instance RightModule (->) Either (These a) + +deriving via FromFunctor IO instance RightModule (->) Either IO + +deriving via FromFunctor (Sum f g) instance (Functor f, Functor g) => RightModule (->) Either (Sum f g) + +deriving via FromFunctor (Product f g) instance (Functor f, Functor g) => RightModule (->) Either (Product f g) + +deriving via (FromFunctor ((,) x1)) instance RightModule (->) Either ((,) x1) + +deriving via (FromFunctor ((,,) x1 x2)) instance RightModule (->) Either ((,,) x1 x2) + deriving via (FromFunctor ((,,,) x1 x2 x3)) instance RightModule (->) Either ((,,,) x1 x2 x3) -deriving via FromFunctor Identity instance RightModule (->) These Identity -deriving via FromFunctor (Compose f g) instance (Functor f, Functor g) => RightModule (->) These (Compose f g) -deriving via FromFunctor [] instance RightModule (->) These [] -deriving via FromFunctor ZipList instance RightModule (->) These ZipList -deriving via FromFunctor NonEmpty instance RightModule (->) These NonEmpty -deriving via FromFunctor Maybe instance RightModule (->) These Maybe -deriving via FromFunctor (Either e) instance RightModule (->) These (Either e) -deriving via FromFunctor (These a) instance RightModule (->) These (These a) -deriving via FromFunctor IO instance RightModule (->) These IO -deriving via FromFunctor (Sum f g) instance (Functor f, Functor g) => RightModule (->) These (Sum f g) -deriving via FromFunctor (Product f g) instance (Functor f, Functor g) => RightModule (->) These (Product f g) -deriving via (FromFunctor ((,) x1)) instance RightModule (->) These ((,) x1) -deriving via (FromFunctor ((,,) x1 x2)) instance RightModule (->) These ((,,) x1 x2) +deriving via FromFunctor Identity instance RightModule (->) These Identity + +deriving via FromFunctor (Compose f g) instance (Functor f, Functor g) => RightModule (->) These (Compose f g) + +deriving via FromFunctor [] instance RightModule (->) These [] + +deriving via FromFunctor ZipList instance RightModule (->) These ZipList + +deriving via FromFunctor NonEmpty instance RightModule (->) These NonEmpty + +deriving via FromFunctor Maybe instance RightModule (->) These Maybe + +deriving via FromFunctor (Either e) instance RightModule (->) These (Either e) + +deriving via FromFunctor (These a) instance RightModule (->) These (These a) + +deriving via FromFunctor IO instance RightModule (->) These IO + +deriving via FromFunctor (Sum f g) instance (Functor f, Functor g) => RightModule (->) These (Sum f g) + +deriving via FromFunctor (Product f g) instance (Functor f, Functor g) => RightModule (->) These (Product f g) + +deriving via (FromFunctor ((,) x1)) instance RightModule (->) These ((,) x1) + +deriving via (FromFunctor ((,,) x1 x2)) instance RightModule (->) These ((,,) x1 x2) + deriving via (FromFunctor ((,,,) x1 x2 x3)) instance RightModule (->) These ((,,,) x1 x2 x3) -deriving via FromFunctor Identity instance RightModule Op (,) Identity -deriving via FromFunctor (Compose f g) instance (Functor f, Functor g) => RightModule Op (,) (Compose f g) -deriving via FromFunctor [] instance RightModule Op (,) [] -deriving via FromFunctor ZipList instance RightModule Op (,) ZipList -deriving via FromFunctor NonEmpty instance RightModule Op (,) NonEmpty -deriving via FromFunctor Maybe instance RightModule Op (,) Maybe -deriving via FromFunctor (Either e) instance RightModule Op (,) (Either e) -deriving via FromFunctor IO instance RightModule Op (,) IO -deriving via FromFunctor (Sum f g) instance (Functor f, Functor g) => RightModule Op (,) (Sum f g) -deriving via FromFunctor (Product f g) instance (Functor f, Functor g) => RightModule Op (,) (Product f g) -deriving via (FromFunctor ((,) x1)) instance RightModule Op (,) ((,) x1) -deriving via (FromFunctor ((,,) x1 x2)) instance RightModule Op (,) ((,,) x1 x2) +deriving via FromFunctor Identity instance RightModule Op (,) Identity + +deriving via FromFunctor (Compose f g) instance (Functor f, Functor g) => RightModule Op (,) (Compose f g) + +deriving via FromFunctor [] instance RightModule Op (,) [] + +deriving via FromFunctor ZipList instance RightModule Op (,) ZipList + +deriving via FromFunctor NonEmpty instance RightModule Op (,) NonEmpty + +deriving via FromFunctor Maybe instance RightModule Op (,) Maybe + +deriving via FromFunctor (Either e) instance RightModule Op (,) (Either e) + +deriving via FromFunctor IO instance RightModule Op (,) IO + +deriving via FromFunctor (Sum f g) instance (Functor f, Functor g) => RightModule Op (,) (Sum f g) + +deriving via FromFunctor (Product f g) instance (Functor f, Functor g) => RightModule Op (,) (Product f g) + +deriving via (FromFunctor ((,) x1)) instance RightModule Op (,) ((,) x1) + +deriving via (FromFunctor ((,,) x1 x2)) instance RightModule Op (,) ((,,) x1 x2) + deriving via (FromFunctor ((,,,) x1 x2 x3)) instance RightModule Op (,) ((,,,) x1 x2 x3) -------------------------------------------------------------------------------- class (LeftModule cat t1 f, RightModule cat t1 f) => Bimodule cat t1 f -instance Contravariant f => Bimodule (->) (,) (FromContra f) where -instance Contravariant f => Bimodule Op Either (FromContra f) where -instance Functor f => Bimodule (->) Either (FromFunctor f) where -instance Functor f => Bimodule (->) These (FromFunctor f) where -instance Functor f => Bimodule Op (,) (FromFunctor f) where +instance Contravariant f => Bimodule (->) (,) (FromContra f) -deriving via (FromContra Comparison) instance Bimodule (->) (,) Comparison -deriving via (FromContra Equivalence) instance Bimodule (->) (,) Equivalence -deriving via (FromContra Predicate) instance Bimodule (->) (,) Predicate -deriving via (FromContra (Op a)) instance Bimodule (->) (,) (Op a) -deriving via (FromContra Proxy) instance Bimodule (->) (,) Proxy -deriving via (FromContra U1) instance Bimodule (->) (,) U1 -deriving via (FromContra V1) instance Bimodule (->) (,) V1 -deriving via (FromContra (Const a)) instance Bimodule (->) (,) (Const a) -deriving via (FromContra (Alt f)) instance Contravariant f => Bimodule (->) (,) (Alt f) -deriving via (FromContra (Rec1 f)) instance Contravariant f => Bimodule (->) (,) (Rec1 f) +instance Contravariant f => Bimodule Op Either (FromContra f) + +instance Functor f => Bimodule (->) Either (FromFunctor f) + +instance Functor f => Bimodule (->) These (FromFunctor f) + +instance Functor f => Bimodule Op (,) (FromFunctor f) + +deriving via (FromContra Comparison) instance Bimodule (->) (,) Comparison + +deriving via (FromContra Equivalence) instance Bimodule (->) (,) Equivalence + +deriving via (FromContra Predicate) instance Bimodule (->) (,) Predicate + +deriving via (FromContra (Op a)) instance Bimodule (->) (,) (Op a) + +deriving via (FromContra Proxy) instance Bimodule (->) (,) Proxy + +deriving via (FromContra U1) instance Bimodule (->) (,) U1 + +deriving via (FromContra V1) instance Bimodule (->) (,) V1 + +deriving via (FromContra (Const a)) instance Bimodule (->) (,) (Const a) + +deriving via (FromContra (Alt f)) instance Contravariant f => Bimodule (->) (,) (Alt f) + +deriving via (FromContra (Rec1 f)) instance Contravariant f => Bimodule (->) (,) (Rec1 f) + deriving via (FromContra (Product f g)) instance (Contravariant f, Contravariant g) => Bimodule (->) (,) (Product f g) -deriving via (FromContra (Sum f g)) instance (Contravariant f, Contravariant g) => Bimodule (->) (,) (Sum f g) -deriving via (FromContra (f :+: g)) instance (Contravariant f, Contravariant g) => Bimodule (->) (,) (f :+: g) -deriving via (FromContra (f :*: g)) instance (Contravariant f, Contravariant g) => Bimodule (->) (,) (f :*: g) -deriving via (FromContra (K1 i c)) instance Bimodule (->) (,) (K1 i c) + +deriving via (FromContra (Sum f g)) instance (Contravariant f, Contravariant g) => Bimodule (->) (,) (Sum f g) + +deriving via (FromContra (f :+: g)) instance (Contravariant f, Contravariant g) => Bimodule (->) (,) (f :+: g) + +deriving via (FromContra (f :*: g)) instance (Contravariant f, Contravariant g) => Bimodule (->) (,) (f :*: g) + +deriving via (FromContra (K1 i c)) instance Bimodule (->) (,) (K1 i c) + deriving via (FromContra (Compose f g)) instance (Functor f, Contravariant g) => Bimodule (->) (,) (Compose f g) -deriving via (FromContra (f :.: g)) instance (Functor f, Contravariant g) => Bimodule (->) (,) (f :.: g) -deriving via (FromContra (M1 i c f)) instance Contravariant f => Bimodule (->) (,) (M1 i c f) -deriving via (FromContra Comparison) instance Bimodule Op Either Comparison -deriving via (FromContra Equivalence) instance Bimodule Op Either Equivalence -deriving via (FromContra Predicate) instance Bimodule Op Either Predicate -deriving via (FromContra (Op a)) instance Bimodule Op Either (Op a) -deriving via (FromContra Proxy) instance Bimodule Op Either Proxy -deriving via (FromContra U1) instance Bimodule Op Either U1 -deriving via (FromContra V1) instance Bimodule Op Either V1 -deriving via (FromContra (Const a)) instance Bimodule Op Either (Const a) -deriving via (FromContra (Alt f)) instance Contravariant f => Bimodule Op Either (Alt f) -deriving via (FromContra (Rec1 f)) instance Contravariant f => Bimodule Op Either (Rec1 f) +deriving via (FromContra (f :.: g)) instance (Functor f, Contravariant g) => Bimodule (->) (,) (f :.: g) + +deriving via (FromContra (M1 i c f)) instance Contravariant f => Bimodule (->) (,) (M1 i c f) + +deriving via (FromContra Comparison) instance Bimodule Op Either Comparison + +deriving via (FromContra Equivalence) instance Bimodule Op Either Equivalence + +deriving via (FromContra Predicate) instance Bimodule Op Either Predicate + +deriving via (FromContra (Op a)) instance Bimodule Op Either (Op a) + +deriving via (FromContra Proxy) instance Bimodule Op Either Proxy + +deriving via (FromContra U1) instance Bimodule Op Either U1 + +deriving via (FromContra V1) instance Bimodule Op Either V1 + +deriving via (FromContra (Const a)) instance Bimodule Op Either (Const a) + +deriving via (FromContra (Alt f)) instance Contravariant f => Bimodule Op Either (Alt f) + +deriving via (FromContra (Rec1 f)) instance Contravariant f => Bimodule Op Either (Rec1 f) + deriving via (FromContra (Product f g)) instance (Contravariant f, Contravariant g) => Bimodule Op Either (Product f g) -deriving via (FromContra (Sum f g)) instance (Contravariant f, Contravariant g) => Bimodule Op Either (Sum f g) -deriving via (FromContra (f :+: g)) instance (Contravariant f, Contravariant g) => Bimodule Op Either (f :+: g) -deriving via (FromContra (f :*: g)) instance (Contravariant f, Contravariant g) => Bimodule Op Either (f :*: g) -deriving via (FromContra (K1 i c)) instance Bimodule Op Either (K1 i c) + +deriving via (FromContra (Sum f g)) instance (Contravariant f, Contravariant g) => Bimodule Op Either (Sum f g) + +deriving via (FromContra (f :+: g)) instance (Contravariant f, Contravariant g) => Bimodule Op Either (f :+: g) + +deriving via (FromContra (f :*: g)) instance (Contravariant f, Contravariant g) => Bimodule Op Either (f :*: g) + +deriving via (FromContra (K1 i c)) instance Bimodule Op Either (K1 i c) + deriving via (FromContra (Compose f g)) instance (Functor f, Contravariant g) => Bimodule Op Either (Compose f g) -deriving via (FromContra (f :.: g)) instance (Functor f, Contravariant g) => Bimodule Op Either (f :.: g) -deriving via (FromContra (M1 i c f)) instance Contravariant f => Bimodule Op Either (M1 i c f) -deriving via FromFunctor Identity instance Bimodule (->) Either Identity -deriving via FromFunctor (Compose f g) instance (Functor f, Functor g) => Bimodule (->) Either (Compose f g) -deriving via FromFunctor [] instance Bimodule (->) Either [] -deriving via FromFunctor ZipList instance Bimodule (->) Either ZipList -deriving via FromFunctor NonEmpty instance Bimodule (->) Either NonEmpty -deriving via FromFunctor Maybe instance Bimodule (->) Either Maybe -deriving via FromFunctor (Either e) instance Bimodule (->) Either (Either e) -deriving via FromFunctor (These a) instance Bimodule (->) Either (These a) -deriving via FromFunctor IO instance Bimodule (->) Either IO -deriving via FromFunctor (Sum f g) instance (Functor f, Functor g) => Bimodule (->) Either (Sum f g) -deriving via FromFunctor (Product f g) instance (Functor f, Functor g) => Bimodule (->) Either (Product f g) -deriving via (FromFunctor ((,) x1)) instance Bimodule (->) Either ((,) x1) -deriving via (FromFunctor ((,,) x1 x2)) instance Bimodule (->) Either ((,,) x1 x2) +deriving via (FromContra (f :.: g)) instance (Functor f, Contravariant g) => Bimodule Op Either (f :.: g) + +deriving via (FromContra (M1 i c f)) instance Contravariant f => Bimodule Op Either (M1 i c f) + +deriving via FromFunctor Identity instance Bimodule (->) Either Identity + +deriving via FromFunctor (Compose f g) instance (Functor f, Functor g) => Bimodule (->) Either (Compose f g) + +deriving via FromFunctor [] instance Bimodule (->) Either [] + +deriving via FromFunctor ZipList instance Bimodule (->) Either ZipList + +deriving via FromFunctor NonEmpty instance Bimodule (->) Either NonEmpty + +deriving via FromFunctor Maybe instance Bimodule (->) Either Maybe + +deriving via FromFunctor (Either e) instance Bimodule (->) Either (Either e) + +deriving via FromFunctor (These a) instance Bimodule (->) Either (These a) + +deriving via FromFunctor IO instance Bimodule (->) Either IO + +deriving via FromFunctor (Sum f g) instance (Functor f, Functor g) => Bimodule (->) Either (Sum f g) + +deriving via FromFunctor (Product f g) instance (Functor f, Functor g) => Bimodule (->) Either (Product f g) + +deriving via (FromFunctor ((,) x1)) instance Bimodule (->) Either ((,) x1) + +deriving via (FromFunctor ((,,) x1 x2)) instance Bimodule (->) Either ((,,) x1 x2) + deriving via (FromFunctor ((,,,) x1 x2 x3)) instance Bimodule (->) Either ((,,,) x1 x2 x3) -deriving via FromFunctor Identity instance Bimodule (->) These Identity -deriving via FromFunctor (Compose f g) instance (Functor f, Functor g) => Bimodule (->) These (Compose f g) -deriving via FromFunctor [] instance Bimodule (->) These [] -deriving via FromFunctor ZipList instance Bimodule (->) These ZipList -deriving via FromFunctor NonEmpty instance Bimodule (->) These NonEmpty -deriving via FromFunctor Maybe instance Bimodule (->) These Maybe -deriving via FromFunctor (Either e) instance Bimodule (->) These (Either e) -deriving via FromFunctor (These a) instance Bimodule (->) These (These a) -deriving via FromFunctor IO instance Bimodule (->) These IO -deriving via FromFunctor (Sum f g) instance (Functor f, Functor g) => Bimodule (->) These (Sum f g) -deriving via FromFunctor (Product f g) instance (Functor f, Functor g) => Bimodule (->) These (Product f g) -deriving via (FromFunctor ((,) x1)) instance Bimodule (->) These ((,) x1) -deriving via (FromFunctor ((,,) x1 x2)) instance Bimodule (->) These ((,,) x1 x2) +deriving via FromFunctor Identity instance Bimodule (->) These Identity + +deriving via FromFunctor (Compose f g) instance (Functor f, Functor g) => Bimodule (->) These (Compose f g) + +deriving via FromFunctor [] instance Bimodule (->) These [] + +deriving via FromFunctor ZipList instance Bimodule (->) These ZipList + +deriving via FromFunctor NonEmpty instance Bimodule (->) These NonEmpty + +deriving via FromFunctor Maybe instance Bimodule (->) These Maybe + +deriving via FromFunctor (Either e) instance Bimodule (->) These (Either e) + +deriving via FromFunctor (These a) instance Bimodule (->) These (These a) + +deriving via FromFunctor IO instance Bimodule (->) These IO + +deriving via FromFunctor (Sum f g) instance (Functor f, Functor g) => Bimodule (->) These (Sum f g) + +deriving via FromFunctor (Product f g) instance (Functor f, Functor g) => Bimodule (->) These (Product f g) + +deriving via (FromFunctor ((,) x1)) instance Bimodule (->) These ((,) x1) + +deriving via (FromFunctor ((,,) x1 x2)) instance Bimodule (->) These ((,,) x1 x2) + deriving via (FromFunctor ((,,,) x1 x2 x3)) instance Bimodule (->) These ((,,,) x1 x2 x3) -deriving via FromFunctor Identity instance Bimodule Op (,) Identity -deriving via FromFunctor (Compose f g) instance (Functor f, Functor g) => Bimodule Op (,) (Compose f g) -deriving via FromFunctor [] instance Bimodule Op (,) [] -deriving via FromFunctor ZipList instance Bimodule Op (,) ZipList -deriving via FromFunctor NonEmpty instance Bimodule Op (,) NonEmpty -deriving via FromFunctor Maybe instance Bimodule Op (,) Maybe -deriving via FromFunctor (Either e) instance Bimodule Op (,) (Either e) -deriving via FromFunctor IO instance Bimodule Op (,) IO -deriving via FromFunctor (Sum f g) instance (Functor f, Functor g) => Bimodule Op (,) (Sum f g) -deriving via FromFunctor (Product f g) instance (Functor f, Functor g) => Bimodule Op (,) (Product f g) -deriving via (FromFunctor ((,) x1)) instance Bimodule Op (,) ((,) x1) -deriving via (FromFunctor ((,,) x1 x2)) instance Bimodule Op (,) ((,,) x1 x2) +deriving via FromFunctor Identity instance Bimodule Op (,) Identity + +deriving via FromFunctor (Compose f g) instance (Functor f, Functor g) => Bimodule Op (,) (Compose f g) + +deriving via FromFunctor [] instance Bimodule Op (,) [] + +deriving via FromFunctor ZipList instance Bimodule Op (,) ZipList + +deriving via FromFunctor NonEmpty instance Bimodule Op (,) NonEmpty + +deriving via FromFunctor Maybe instance Bimodule Op (,) Maybe + +deriving via FromFunctor (Either e) instance Bimodule Op (,) (Either e) + +deriving via FromFunctor IO instance Bimodule Op (,) IO + +deriving via FromFunctor (Sum f g) instance (Functor f, Functor g) => Bimodule Op (,) (Sum f g) + +deriving via FromFunctor (Product f g) instance (Functor f, Functor g) => Bimodule Op (,) (Product f g) + +deriving via (FromFunctor ((,) x1)) instance Bimodule Op (,) ((,) x1) + +deriving via (FromFunctor ((,,) x1 x2)) instance Bimodule Op (,) ((,,) x1 x2) + deriving via (FromFunctor ((,,,) x1 x2 x3)) instance Bimodule Op (,) ((,,,) x1 x2 x3) diff --git a/src/Data/Functor/Monoidal.hs b/src/Data/Functor/Monoidal.hs --- a/src/Data/Functor/Monoidal.hs +++ b/src/Data/Functor/Monoidal.hs @@ -1,6 +1,13 @@ module Data.Functor.Monoidal ( -- * Semigroupal Semigroupal (..), + (|?|), + (|*|), + type (|*|), + (|+|), + type (|+|), + (|&|), + type (|&|), -- * Unital Unital (..), @@ -13,13 +20,29 @@ -------------------------------------------------------------------------------- import Control.Applicative +import Control.Applicative.Backwards (Backwards) import Control.Arrow (ArrowMonad, ArrowPlus, ArrowZero, Kleisli) import Control.Category.Tensor +import Control.Comonad.Identity (IdentityT) import Control.Monad (MonadPlus) +import Control.Monad.Trans.Except (ExceptT) +import Control.Monad.Trans.Maybe +import Control.Monad.Trans.RWS.Lazy qualified as Lazy +import Control.Monad.Trans.RWS.Strict (RWST) +import Control.Monad.Trans.Reader (ReaderT) +import Control.Monad.Trans.State.Lazy qualified as Lazy +import Control.Monad.Trans.State.Strict (StateT) +import Control.Monad.Trans.Writer.Lazy qualified as Lazy +import Control.Monad.Trans.Writer.Strict (WriterT) import Data.Align import Data.Functor.Compose (Compose) +import Data.Functor.Constant (Constant) +import Data.Functor.Contravariant (Comparison, Contravariant, Equivalence, Op (..), Predicate) +import Data.Functor.Contravariant.Compose (ComposeCF, ComposeFC) +import Data.Functor.Contravariant.Divisible (Decidable, Divisible, chosen, conquered, divided, lost) import Data.Functor.Identity import Data.Functor.Product (Product) +import Data.Functor.Reverse (Reverse) import Data.Kind (Type) import Data.List.NonEmpty (NonEmpty) import Data.Monoid (Alt, Ap) @@ -43,7 +66,7 @@ -- -- __Associativity:__ -- --- \[ +-- \[ -- \require{AMScd} -- \begin{CD} -- (F A \bullet F B) \bullet F C @>>{\alpha_{\mathcal{D}}}> F A \bullet (F B \bullet F C) \\ @@ -82,19 +105,38 @@ combine :: (FromApplicative f x, FromApplicative f x') -> FromApplicative f (x, x') combine = uncurry (liftA2 (,)) -deriving via FromApplicative Identity instance Semigroupal (->) (,) (,) Identity -deriving via FromApplicative (Compose f g) instance (Applicative f, Applicative g) => Semigroupal (->) (,) (,) (Compose f g) -deriving via FromApplicative [] instance Semigroupal (->) (,) (,) [] -deriving via FromApplicative ZipList instance Semigroupal (->) (,) (,) ZipList -deriving via FromApplicative NonEmpty instance Semigroupal (->) (,) (,) NonEmpty -deriving via FromApplicative Maybe instance Semigroupal (->) (,) (,) Maybe -deriving via FromApplicative (Either e) instance Semigroupal (->) (,) (,) (Either e) -deriving via FromApplicative IO instance Semigroupal (->) (,) (,) IO -deriving via FromApplicative (Product f g) instance (Applicative f, Applicative g) => Semigroupal (->) (,) (,) (Product f g) -deriving via (FromApplicative ((,) x1)) instance (Monoid x1) => Semigroupal (->) (,) (,) ((,) x1) -deriving via (FromApplicative ((,,) x1 x2)) instance (Monoid x1, Monoid x2) => Semigroupal (->) (,) (,) ((,,) x1 x2) +deriving via FromApplicative Identity instance Semigroupal (->) (,) (,) Identity + +instance Semigroupal Op Either Either Identity where + combine :: Op (Either (Identity x) (Identity x')) (Identity (Either x x')) + combine = Op $ \case + Identity (Left x) -> Left $ Identity x + Identity (Right x') -> Right $ Identity x' + +deriving via FromApplicative (Compose f g) instance (Applicative f, Applicative g) => Semigroupal (->) (,) (,) (Compose f g) + +deriving via FromApplicative [] instance Semigroupal (->) (,) (,) [] + +deriving via FromApplicative ZipList instance Semigroupal (->) (,) (,) ZipList + +deriving via FromApplicative NonEmpty instance Semigroupal (->) (,) (,) NonEmpty + +deriving via FromApplicative Maybe instance Semigroupal (->) (,) (,) Maybe + +deriving via FromApplicative (Either e) instance Semigroupal (->) (,) (,) (Either e) + +deriving via FromApplicative IO instance Semigroupal (->) (,) (,) IO + +deriving via FromApplicative (Product f g) instance (Applicative f, Applicative g) => Semigroupal (->) (,) (,) (Product f g) + +deriving via (FromApplicative ((,) x1)) instance (Monoid x1) => Semigroupal (->) (,) (,) ((,) x1) + +deriving via (FromApplicative ((,,) x1 x2)) instance (Monoid x1, Monoid x2) => Semigroupal (->) (,) (,) ((,,) x1 x2) + deriving via (FromApplicative ((,,,) x1 x2 x3)) instance (Monoid x1, Monoid x2, Monoid x3) => Semigroupal (->) (,) (,) ((,,,) x1 x2 x3) +deriving via FromApplicative (Proxy :: Type -> Type) instance Semigroupal (->) (,) (,) (Proxy :: Type -> Type) + newtype FromAlternative f a = FromAlternative (f a) deriving newtype (Functor, Applicative, Alternative) @@ -102,45 +144,209 @@ combine :: (FromAlternative f x, FromAlternative f x') -> FromAlternative f (Either x x') combine (fx, fx') = fmap Left fx <|> fmap Right fx' -deriving via FromAlternative ZipList instance Semigroupal (->) Either (,) ZipList -deriving via FromAlternative STM instance Semigroupal (->) Either (,) STM -deriving via FromAlternative ReadP instance Semigroupal (->) Either (,) ReadP -deriving via FromAlternative ReadPrec instance Semigroupal (->) Either (,) ReadPrec -deriving via FromAlternative IO instance Semigroupal (->) Either (,) IO -deriving via FromAlternative Maybe instance Semigroupal (->) Either (,) Maybe -deriving via FromAlternative [] instance Semigroupal (->) Either (,) [] -deriving via FromAlternative (WrappedMonad m) instance (MonadPlus m) => Semigroupal (->) Either (,) (WrappedMonad m) -deriving via FromAlternative (ArrowMonad a) instance (ArrowPlus a) => Semigroupal (->) Either (,) (ArrowMonad a) +deriving via FromAlternative ZipList instance Semigroupal (->) Either (,) ZipList + +deriving via FromAlternative STM instance Semigroupal (->) Either (,) STM + +deriving via FromAlternative ReadP instance Semigroupal (->) Either (,) ReadP + +deriving via FromAlternative ReadPrec instance Semigroupal (->) Either (,) ReadPrec + +deriving via FromAlternative IO instance Semigroupal (->) Either (,) IO + +deriving via FromAlternative Maybe instance Semigroupal (->) Either (,) Maybe + +deriving via FromAlternative [] instance Semigroupal (->) Either (,) [] + +deriving via FromAlternative (WrappedMonad m) instance (MonadPlus m) => Semigroupal (->) Either (,) (WrappedMonad m) + +deriving via FromAlternative (ArrowMonad a) instance (ArrowPlus a) => Semigroupal (->) Either (,) (ArrowMonad a) + deriving via FromAlternative (Proxy :: Type -> Type) instance Semigroupal (->) Either (,) (Proxy :: Type -> Type) -deriving via FromAlternative (U1 :: Type -> Type) instance Semigroupal (->) Either (,) (U1 :: Type -> Type) -deriving via FromAlternative (WrappedArrow a b) instance (ArrowZero a, ArrowPlus a) => Semigroupal (->) Either (,) (WrappedArrow a b) -deriving via FromAlternative (Kleisli m a) instance (Alternative m) => Semigroupal (->) Either (,) (Kleisli m a) -deriving via FromAlternative (Ap f) instance (Alternative f) => Semigroupal (->) Either (,) (Ap f) -deriving via FromAlternative (Alt f) instance (Alternative f) => Semigroupal (->) Either (,) (Alt f) -deriving via FromAlternative (Rec1 f) instance (Alternative f) => Semigroupal (->) Either (,) (Rec1 f) -deriving via FromAlternative (Product f g) instance (Alternative f, Alternative g) => Semigroupal (->) Either (,) (Product f g) -deriving via FromAlternative (f :*: g) instance (Alternative f, Alternative g) => Semigroupal (->) Either (,) (f :*: g) -deriving via FromAlternative (f `Compose` g) instance (Alternative f, Applicative g) => Semigroupal (->) Either (,) (f `Compose` g) -deriving via FromAlternative (f :.: g) instance (Alternative f, Applicative g) => Semigroupal (->) Either (,) (f :.: g) -deriving via FromAlternative (M1 i c f) instance (Alternative f) => Semigroupal (->) Either (,) (M1 i c f) +deriving via FromAlternative (U1 :: Type -> Type) instance Semigroupal (->) Either (,) (U1 :: Type -> Type) + +deriving via FromAlternative (WrappedArrow a b) instance (ArrowZero a, ArrowPlus a) => Semigroupal (->) Either (,) (WrappedArrow a b) + +deriving via FromAlternative (Kleisli m a) instance (Alternative m) => Semigroupal (->) Either (,) (Kleisli m a) + +deriving via FromAlternative (Ap f) instance (Alternative f) => Semigroupal (->) Either (,) (Ap f) + +deriving via FromAlternative (Alt f) instance (Alternative f) => Semigroupal (->) Either (,) (Alt f) + +deriving via FromAlternative (Rec1 f) instance (Alternative f) => Semigroupal (->) Either (,) (Rec1 f) + +deriving via FromAlternative (Product f g) instance (Alternative f, Alternative g) => Semigroupal (->) Either (,) (Product f g) + +deriving via FromAlternative (f :*: g) instance (Alternative f, Alternative g) => Semigroupal (->) Either (,) (f :*: g) + +deriving via FromAlternative (f `Compose` g) instance (Alternative f, Applicative g) => Semigroupal (->) Either (,) (f `Compose` g) + +deriving via FromAlternative (f :.: g) instance (Alternative f, Applicative g) => Semigroupal (->) Either (,) (f :.: g) + +deriving via FromAlternative (M1 i c f) instance (Alternative f) => Semigroupal (->) Either (,) (M1 i c f) + newtype FromSemialign f a = FromSemialign (f a) - deriving (Functor, Semialign) + deriving newtype (Functor, Semialign) instance Semialign f => Semigroupal (->) These (,) (FromSemialign f) where combine :: (FromSemialign f x, FromSemialign f x') -> FromSemialign f (These x x') combine = uncurry align -deriving via FromSemialign [] instance Semigroupal (->) These (,) [] -deriving via FromSemialign ZipList instance Semigroupal (->) These (,) ZipList -deriving via FromSemialign NonEmpty instance Semigroupal (->) These (,) NonEmpty -deriving via FromSemialign Maybe instance Semigroupal (->) These (,) Maybe -deriving via FromSemialign Identity instance Semigroupal (->) These (,) Identity +deriving via FromSemialign [] instance Semigroupal (->) These (,) [] + +deriving via FromSemialign ZipList instance Semigroupal (->) These (,) ZipList + +deriving via FromSemialign NonEmpty instance Semigroupal (->) These (,) NonEmpty + +deriving via FromSemialign Maybe instance Semigroupal (->) These (,) Maybe + +deriving via FromSemialign Identity instance Semigroupal (->) These (,) Identity + deriving via FromSemialign (Proxy :: Type -> Type) instance Semigroupal (->) These (,) (Proxy :: Type -> Type) -deriving via FromSemialign (Tagged b) instance Semigroupal (->) These (,) (Tagged b) -deriving via FromSemialign (Product f g) instance (Semialign f, Semialign g) => Semigroupal (->) These (,) (Product f g) -deriving via FromSemialign (f `Compose` g) instance (Semialign f, Semialign g) => Semigroupal (->) These (,) (f `Compose` g) +deriving via FromSemialign (Tagged b) instance Semigroupal (->) These (,) (Tagged b) + +deriving via FromSemialign (Product f g) instance (Semialign f, Semialign g) => Semigroupal (->) These (,) (Product f g) + +deriving via FromSemialign (f `Compose` g) instance (Semialign f, Semialign g) => Semigroupal (->) These (,) (f `Compose` g) + +newtype FromDivisible f a = FromDivisible (f a) + deriving newtype (Contravariant, Divisible) + +instance Divisible f => Semigroupal (->) (,) (,) (FromDivisible f) where + combine :: (FromDivisible f x, FromDivisible f x') -> FromDivisible f (x, x') + combine = uncurry divided + +deriving via FromDivisible Predicate instance Semigroupal (->) (,) (,) Predicate + +deriving via FromDivisible Comparison instance Semigroupal (->) (,) (,) Comparison + +deriving via FromDivisible Equivalence instance Semigroupal (->) (,) (,) Equivalence + +deriving via FromDivisible (U1 :: Type -> Type) instance Semigroupal (->) (,) (,) (U1 :: Type -> Type) + +deriving via FromDivisible (Op r) instance Monoid r => Semigroupal (->) (,) (,) (Op r) + +-- deriving via FromDivisible (Proxy :: Type -> Type) instance Semigroupal (->) (,) (,) (Proxy :: Type -> Type) +deriving via FromDivisible (MaybeT m) instance Divisible m => Semigroupal (->) (,) (,) (MaybeT m) + +deriving via FromDivisible (Rec1 m) instance Divisible m => Semigroupal (->) (,) (,) (Rec1 m) + +deriving via FromDivisible (Const m) instance Monoid m => Semigroupal (->) (,) (,) (Const m :: Type -> Type) + +deriving via FromDivisible (Alt f) instance Divisible f => Semigroupal (->) (,) (,) (Alt f) + +deriving via FromDivisible (Reverse f) instance Divisible f => Semigroupal (->) (,) (,) (Reverse f) + +deriving via FromDivisible (Constant m) instance Monoid m => Semigroupal (->) (,) (,) (Constant m :: Type -> Type) + +deriving via FromDivisible (WriterT w m) instance Divisible m => Semigroupal (->) (,) (,) (WriterT w m) + +deriving via FromDivisible (Lazy.WriterT w m) instance Divisible m => Semigroupal (->) (,) (,) (Lazy.WriterT w m) + +deriving via FromDivisible (StateT w m) instance Divisible m => Semigroupal (->) (,) (,) (StateT w m) + +deriving via FromDivisible (Lazy.StateT w m) instance Divisible m => Semigroupal (->) (,) (,) (Lazy.StateT w m) + +deriving via FromDivisible (ReaderT r m) instance Divisible m => Semigroupal (->) (,) (,) (ReaderT r m) + +deriving via FromDivisible (IdentityT m) instance Divisible m => Semigroupal (->) (,) (,) (IdentityT m) + +deriving via FromDivisible (ExceptT e m) instance Divisible m => Semigroupal (->) (,) (,) (ExceptT e m) + +deriving via FromDivisible (Backwards f) instance Divisible f => Semigroupal (->) (,) (,) (Backwards f) + +deriving via FromDivisible (ComposeCF f g) instance (Divisible f, Applicative g) => Semigroupal (->) (,) (,) (ComposeCF f g) + +deriving via FromDivisible (ComposeFC f g) instance (Divisible g, Applicative f) => Semigroupal (->) (,) (,) (ComposeFC f g) + +deriving via FromDivisible (f :*: g) instance (Divisible f, Divisible g) => Semigroupal (->) (,) (,) (f :*: g) + +-- deriving via FromDivisible (Product f g) instance (Divisible f, Divisible g) => Semigroupal (->) (,) (,) (Product f g) +deriving via FromDivisible (M1 i c f) instance Divisible f => Semigroupal (->) (,) (,) (M1 i c f) + +deriving via FromDivisible (f :.: g) instance (Applicative f, Divisible g) => Semigroupal (->) (,) (,) (f :.: g) + +-- deriving via FromDivisible (Compose f g) instance (Applicative f, Divisible g) => Semigroupal (->) (,) (,) (Compose f g) +deriving via FromDivisible (RWST r w s m) instance (Divisible m) => Semigroupal (->) (,) (,) (RWST r w s m) + +deriving via FromDivisible (Lazy.RWST r w s m) instance (Divisible m) => Semigroupal (->) (,) (,) (Lazy.RWST r w s m) + +newtype FromDecidable f a = FromDecidable (f a) + deriving newtype (Contravariant, Divisible, Decidable) + +instance Decidable f => Semigroupal (->) Either (,) (FromDecidable f) where + combine :: (FromDecidable f x, FromDecidable f x') -> FromDecidable f (Either x x') + combine = uncurry chosen + +deriving via FromDecidable Predicate instance Semigroupal (->) Either (,) Predicate + +deriving via FromDecidable Comparison instance Semigroupal (->) Either (,) Comparison + +deriving via FromDecidable Equivalence instance Semigroupal (->) Either (,) Equivalence + +-- deriving via FromDecidable (U1 :: Type -> Type) instance Semigroupal (->) Either (,) (U1 :: Type -> Type) +deriving via FromDecidable (Op r) instance Monoid r => Semigroupal (->) Either (,) (Op r) + +-- deriving via FromDecidable (Proxy :: Type -> Type) instance Semigroupal (->) Either (,) (Proxy :: Type -> Type) +deriving via FromDecidable (MaybeT m) instance Decidable m => Semigroupal (->) Either (,) (MaybeT m) + +-- deriving via FromDecidable (Rec1 m) instance Decidable m => Semigroupal (->) Either (,) (Rec1 m) +-- deriving via FromDecidable (Alt f) instance Decidable f => Semigroupal (->) Either (,) (Alt f) +deriving via FromDecidable (Reverse f) instance Decidable f => Semigroupal (->) Either (,) (Reverse f) + +deriving via FromDecidable (WriterT w m) instance Decidable m => Semigroupal (->) Either (,) (WriterT w m) + +deriving via FromDecidable (Lazy.WriterT w m) instance Decidable m => Semigroupal (->) Either (,) (Lazy.WriterT w m) + +deriving via FromDecidable (StateT w m) instance Decidable m => Semigroupal (->) Either (,) (StateT w m) + +deriving via FromDecidable (Lazy.StateT w m) instance Decidable m => Semigroupal (->) Either (,) (Lazy.StateT w m) + +deriving via FromDecidable (ReaderT r m) instance Decidable m => Semigroupal (->) Either (,) (ReaderT r m) + +deriving via FromDecidable (IdentityT m) instance Decidable m => Semigroupal (->) Either (,) (IdentityT m) + +deriving via FromDecidable (Backwards f) instance Decidable f => Semigroupal (->) Either (,) (Backwards f) + +deriving via FromDecidable (ComposeFC f g) instance (Decidable g, Applicative f) => Semigroupal (->) Either (,) (ComposeFC f g) + +-- deriving via FromDecidable (f :*: g) instance (Decidable f, Decidable g) => Semigroupal (->) Either (,) (f :*: g) +-- deriving via FromDecidable (Product f g) instance (Decidable f, Decidable g) => Semigroupal (->) Either (,) (Product f g) +-- deriving via FromDecidable (M1 i c f) instance Decidable f => Semigroupal (->) Either (,) (M1 i c f) +-- deriving via FromDecidable (f :.: g) instance (Applicative f, Decidable g) => Semigroupal (->) Either (,) (f :.: g) +-- deriving via FromDecidable (Compose f g) instance (Applicative f, Decidable g) => Semigroupal (->) Either (,) (Compose f g) +deriving via FromDecidable (RWST r w s m) instance (Decidable m) => Semigroupal (->) Either (,) (RWST r w s m) + +deriving via FromDecidable (Lazy.RWST r w s m) instance (Decidable m) => Semigroupal (->) Either (,) (Lazy.RWST r w s m) + +infixr 9 |?| + +(|?|) :: Semigroupal (->) t1 (,) f => f a -> f b -> f (a `t1` b) +(|?|) = curry combine + +infixr 4 |*| + +(|*|) :: Semigroupal (->) (,) (,) f => f a -> f b -> f (a, b) +(|*|) = curry combine + +infixr 3 |+| + +(|+|) :: Semigroupal (->) Either (,) f => f a -> f b -> f (Either a b) +(|+|) = curry combine + +infixr 3 |&| + +(|&|) :: Semigroupal (->) These (,) f => f a -> f b -> f (These a b) +(|&|) = curry combine + +type (|*|) = (,) + +type (|+|) = Either + +type (|&|) = These + -------------------------------------------------------------------------------- -- | Given monoidal categories \((\mathcal{C}, \otimes, I_{\mathcal{C}})\) and \((\mathcal{D}, \bullet, I_{\mathcal{D}})\). @@ -155,9 +361,9 @@ -- >>> introduce @(->) @() @() @Maybe () -- Just () -- - -- >>> :t introduce @(->) @Void @() @Maybe + -- >>> :t introduce @(->) @Void @() @Maybe -- introduce @(->) @Void @() @Maybe :: () -> Maybe Void - -- + -- -- >>> introduce @(->) @Void @() @Maybe () -- Nothing introduce :: cat i0 (f i1) @@ -166,45 +372,180 @@ introduce :: () -> FromApplicative f () introduce = pure -deriving via FromApplicative Identity instance Unital (->) () () Identity -deriving via FromApplicative (Compose f g) instance (Applicative f, Applicative g) => Unital (->) () () (Compose f g) -deriving via FromApplicative [] instance Unital (->) () () [] -deriving via FromApplicative ZipList instance Unital (->) () () ZipList -deriving via FromApplicative NonEmpty instance Unital (->) () () NonEmpty -deriving via FromApplicative Maybe instance Unital (->) () () Maybe -deriving via FromApplicative (Either e) instance Unital (->) () () (Either e) -deriving via FromApplicative IO instance Unital (->) () () IO -deriving via FromApplicative (Product f g) instance (Applicative f, Applicative g) => Unital (->) () () (Product f g) -deriving via (FromApplicative ((,) x1)) instance (Monoid x1) => Unital (->) () () ((,) x1) -deriving via (FromApplicative ((,,) x1 x2)) instance (Monoid x1, Monoid x2) => Unital (->) () () ((,,) x1 x2) +deriving via FromApplicative Identity instance Unital (->) () () Identity + +deriving via FromApplicative (Compose f g) instance (Applicative f, Applicative g) => Unital (->) () () (Compose f g) + +deriving via FromApplicative [] instance Unital (->) () () [] + +deriving via FromApplicative ZipList instance Unital (->) () () ZipList + +deriving via FromApplicative NonEmpty instance Unital (->) () () NonEmpty + +deriving via FromApplicative Maybe instance Unital (->) () () Maybe + +deriving via FromApplicative (Either e) instance Unital (->) () () (Either e) + +deriving via FromApplicative IO instance Unital (->) () () IO + +deriving via FromApplicative (Product f g) instance (Applicative f, Applicative g) => Unital (->) () () (Product f g) + +deriving via (FromApplicative ((,) x1)) instance (Monoid x1) => Unital (->) () () ((,) x1) + +deriving via (FromApplicative ((,,) x1 x2)) instance (Monoid x1, Monoid x2) => Unital (->) () () ((,,) x1 x2) + deriving via (FromApplicative ((,,,) x1 x2 x3)) instance (Monoid x1, Monoid x2, Monoid x3) => Unital (->) () () ((,,,) x1 x2 x3) instance Alternative f => Unital (->) Void () (FromAlternative f) where introduce :: () -> FromAlternative f Void introduce () = empty -deriving via FromAlternative ZipList instance Unital (->) Void () ZipList -deriving via FromAlternative STM instance Unital (->) Void () STM -deriving via FromAlternative ReadP instance Unital (->) Void () ReadP -deriving via FromAlternative ReadPrec instance Unital (->) Void () ReadPrec -deriving via FromAlternative IO instance Unital (->) Void () IO -deriving via FromAlternative Maybe instance Unital (->) Void () Maybe -deriving via FromAlternative [] instance Unital (->) Void () [] -deriving via FromAlternative (WrappedMonad m) instance (MonadPlus m) => Unital (->) Void () (WrappedMonad m) -deriving via FromAlternative (ArrowMonad a) instance (ArrowPlus a) => Unital (->) Void () (ArrowMonad a) +deriving via FromAlternative ZipList instance Unital (->) Void () ZipList + +deriving via FromAlternative STM instance Unital (->) Void () STM + +deriving via FromAlternative ReadP instance Unital (->) Void () ReadP + +deriving via FromAlternative ReadPrec instance Unital (->) Void () ReadPrec + +deriving via FromAlternative IO instance Unital (->) Void () IO + +deriving via FromAlternative Maybe instance Unital (->) Void () Maybe + +deriving via FromAlternative [] instance Unital (->) Void () [] + +deriving via FromAlternative (WrappedMonad m) instance (MonadPlus m) => Unital (->) Void () (WrappedMonad m) + +deriving via FromAlternative (ArrowMonad a) instance (ArrowPlus a) => Unital (->) Void () (ArrowMonad a) + deriving via FromAlternative (Proxy :: Type -> Type) instance Unital (->) Void () (Proxy :: Type -> Type) -deriving via FromAlternative (U1 :: Type -> Type) instance Unital (->) Void () (U1 :: Type -> Type) -deriving via FromAlternative (WrappedArrow a b) instance (ArrowZero a, ArrowPlus a) => Unital (->) Void () (WrappedArrow a b) -deriving via FromAlternative (Kleisli m a) instance (Alternative m) => Unital (->) Void () (Kleisli m a) -deriving via FromAlternative (Ap f) instance (Alternative f) => Unital (->) Void () (Ap f) -deriving via FromAlternative (Alt f) instance (Alternative f) => Unital (->) Void () (Alt f) -deriving via FromAlternative (Rec1 f) instance (Alternative f) => Unital (->) Void () (Rec1 f) -deriving via FromAlternative (Product f g) instance (Alternative f, Alternative g) => Unital (->) Void () (Product f g) -deriving via FromAlternative (f :*: g) instance (Alternative f, Alternative g) => Unital (->) Void () (f :*: g) -deriving via FromAlternative (f `Compose` g) instance (Alternative f, Applicative g) => Unital (->) Void () (f `Compose` g) -deriving via FromAlternative (f :.: g) instance (Alternative f, Applicative g) => Unital (->) Void () (f :.: g) -deriving via FromAlternative (M1 i c f) instance (Alternative f) => Unital (->) Void () (M1 i c f) +deriving via FromAlternative (U1 :: Type -> Type) instance Unital (->) Void () (U1 :: Type -> Type) + +deriving via FromAlternative (WrappedArrow a b) instance (ArrowZero a, ArrowPlus a) => Unital (->) Void () (WrappedArrow a b) + +deriving via FromAlternative (Kleisli m a) instance (Alternative m) => Unital (->) Void () (Kleisli m a) + +deriving via FromAlternative (Ap f) instance (Alternative f) => Unital (->) Void () (Ap f) + +deriving via FromAlternative (Alt f) instance (Alternative f) => Unital (->) Void () (Alt f) + +deriving via FromAlternative (Rec1 f) instance (Alternative f) => Unital (->) Void () (Rec1 f) + +deriving via FromAlternative (Product f g) instance (Alternative f, Alternative g) => Unital (->) Void () (Product f g) + +deriving via FromAlternative (f :*: g) instance (Alternative f, Alternative g) => Unital (->) Void () (f :*: g) + +deriving via FromAlternative (f `Compose` g) instance (Alternative f, Applicative g) => Unital (->) Void () (f `Compose` g) + +deriving via FromAlternative (f :.: g) instance (Alternative f, Applicative g) => Unital (->) Void () (f :.: g) + +deriving via FromAlternative (M1 i c f) instance (Alternative f) => Unital (->) Void () (M1 i c f) + +instance Divisible f => Unital (->) () () (FromDivisible f) where + introduce :: () -> FromDivisible f () + introduce () = FromDivisible conquered + +deriving via FromDivisible Predicate instance Unital (->) () () Predicate + +deriving via FromDivisible Comparison instance Unital (->) () () Comparison + +deriving via FromDivisible Equivalence instance Unital (->) () () Equivalence + +deriving via FromDivisible (U1 :: Type -> Type) instance Unital (->) () () (U1 :: Type -> Type) + +deriving via FromDivisible (Op r) instance Monoid r => Unital (->) () () (Op r) + +-- deriving via FromDivisible (Proxy :: Type -> Type) instance Unital (->) () () (Proxy :: Type -> Type) +deriving via FromDivisible (MaybeT m) instance Divisible m => Unital (->) () () (MaybeT m) + +deriving via FromDivisible (Rec1 m) instance Divisible m => Unital (->) () () (Rec1 m) + +deriving via FromDivisible (Const m) instance Monoid m => Unital (->) () () (Const m :: Type -> Type) + +deriving via FromDivisible (Alt f) instance Divisible f => Unital (->) () () (Alt f) + +deriving via FromDivisible (Reverse f) instance Divisible f => Unital (->) () () (Reverse f) + +deriving via FromDivisible (Constant m) instance Monoid m => Unital (->) () () (Constant m :: Type -> Type) + +deriving via FromDivisible (WriterT w m) instance Divisible m => Unital (->) () () (WriterT w m) + +deriving via FromDivisible (Lazy.WriterT w m) instance Divisible m => Unital (->) () () (Lazy.WriterT w m) + +deriving via FromDivisible (StateT w m) instance Divisible m => Unital (->) () () (StateT w m) + +deriving via FromDivisible (Lazy.StateT w m) instance Divisible m => Unital (->) () () (Lazy.StateT w m) + +deriving via FromDivisible (ReaderT r m) instance Divisible m => Unital (->) () () (ReaderT r m) + +deriving via FromDivisible (IdentityT m) instance Divisible m => Unital (->) () () (IdentityT m) + +deriving via FromDivisible (ExceptT e m) instance Divisible m => Unital (->) () () (ExceptT e m) + +deriving via FromDivisible (Backwards f) instance Divisible f => Unital (->) () () (Backwards f) + +deriving via FromDivisible (ComposeCF f g) instance (Divisible f, Applicative g) => Unital (->) () () (ComposeCF f g) + +deriving via FromDivisible (ComposeFC f g) instance (Divisible g, Applicative f) => Unital (->) () () (ComposeFC f g) + +deriving via FromDivisible (f :*: g) instance (Divisible f, Divisible g) => Unital (->) () () (f :*: g) + +-- deriving via FromDivisible (Product f g) instance (Divisible f, Divisible g) => Unital (->) () () (Product f g) +deriving via FromDivisible (M1 i c f) instance Divisible f => Unital (->) () () (M1 i c f) + +deriving via FromDivisible (f :.: g) instance (Applicative f, Divisible g) => Unital (->) () () (f :.: g) + +-- deriving via FromDivisible (Compose f g) instance (Applicative f, Divisible g) => Unital (->) () () (Compose f g) +deriving via FromDivisible (RWST r w s m) instance (Divisible m) => Unital (->) () () (RWST r w s m) + +deriving via FromDivisible (Lazy.RWST r w s m) instance (Divisible m) => Unital (->) () () (Lazy.RWST r w s m) + +instance Decidable f => Unital (->) Void () (FromDecidable f) where + introduce :: () -> FromDecidable f Void + introduce () = FromDecidable lost + +deriving via FromDecidable Predicate instance Unital (->) Void () Predicate + +deriving via FromDecidable Comparison instance Unital (->) Void () Comparison + +deriving via FromDecidable Equivalence instance Unital (->) Void () Equivalence + +-- deriving via FromDecidable (U1 :: Type -> Type) instance Unital (->) Void () (U1 :: Type -> Type) +deriving via FromDecidable (Op r) instance Monoid r => Unital (->) Void () (Op r) + +-- deriving via FromDecidable (Proxy :: Type -> Type) instance Unital (->) Void () (Proxy :: Type -> Type) +deriving via FromDecidable (MaybeT m) instance Decidable m => Unital (->) Void () (MaybeT m) + +-- deriving via FromDecidable (Rec1 m) instance Decidable m => Unital (->) Void () (Rec1 m) +-- deriving via FromDecidable (Alt f) instance Decidable f => Unital (->) Void () (Alt f) +deriving via FromDecidable (Reverse f) instance Decidable f => Unital (->) Void () (Reverse f) + +deriving via FromDecidable (WriterT w m) instance Decidable m => Unital (->) Void () (WriterT w m) + +deriving via FromDecidable (Lazy.WriterT w m) instance Decidable m => Unital (->) Void () (Lazy.WriterT w m) + +deriving via FromDecidable (StateT w m) instance Decidable m => Unital (->) Void () (StateT w m) + +deriving via FromDecidable (Lazy.StateT w m) instance Decidable m => Unital (->) Void () (Lazy.StateT w m) + +deriving via FromDecidable (ReaderT r m) instance Decidable m => Unital (->) Void () (ReaderT r m) + +deriving via FromDecidable (IdentityT m) instance Decidable m => Unital (->) Void () (IdentityT m) + +deriving via FromDecidable (Backwards f) instance Decidable f => Unital (->) Void () (Backwards f) + +deriving via FromDecidable (ComposeFC f g) instance (Decidable g, Applicative f) => Unital (->) Void () (ComposeFC f g) + +-- deriving via FromDecidable (f :*: g) instance (Decidable f, Decidable g) => Unital (->) Void () (f :*: g) +-- deriving via FromDecidable (Product f g) instance (Decidable f, Decidable g) => Unital (->) Void () (Product f g) +-- deriving via FromDecidable (M1 i c f) instance Decidable f => Unital (->) Void () (M1 i c f) +-- deriving via FromDecidable (f :.: g) instance (Applicative f, Decidable g) => Unital (->) Void () (f :.: g) +-- deriving via FromDecidable (Compose f g) instance (Applicative f, Decidable g) => Unital (->) Void () (Compose f g) +deriving via FromDecidable (RWST r w s m) instance (Decidable m) => Unital (->) Void () (RWST r w s m) + +deriving via FromDecidable (Lazy.RWST r w s m) instance (Decidable m) => Unital (->) Void () (Lazy.RWST r w s m) + -------------------------------------------------------------------------------- -- | Given monoidal categories \((\mathcal{C}, \otimes, I_{\mathcal{C}})\) and \((\mathcal{D}, \bullet, I_{\mathcal{D}})\). @@ -217,7 +558,7 @@ -- -- __Right Unitality__: -- --- \[ +-- \[ -- \require{AMScd} -- \begin{CD} -- F A \bullet I_{\mathcal{D}} @>{1 \bullet \phi}>> F A \bullet F I_{\mathcal{C}};\\ @@ -232,7 +573,7 @@ -- -- __ Left Unitality__: -- --- \[ +-- \[ -- \begin{CD} -- I_{\mathcal{D}} \bullet F B @>{\phi \bullet 1}>> F I_{\mathcal{C}} \bullet F B;\\ -- @VV{\lambda_{\mathcal{D}}}V @VV{\phi I_{\mathcal{C}},B}V \\ @@ -244,47 +585,175 @@ -- 'combine' 'Control.Category..' 'glmap' 'introduce' ≡ 'fmap' ('bwd' 'unitl') 'Control.Category..' 'fwd' 'unitl' -- @ class - ( Tensor cat t1 i1 - , Tensor cat t0 i0 - , Semigroupal cat t1 t0 f - , Unital cat i1 i0 f - ) => Monoidal cat t1 i1 t0 i0 f + ( Tensor cat t1 i1, + Tensor cat t0 i0, + Semigroupal cat t1 t0 f, + Unital cat i1 i0 f + ) => + Monoidal cat t1 i1 t0 i0 f instance Applicative f => Monoidal (->) (,) () (,) () (FromApplicative f) -deriving via FromApplicative Identity instance Monoidal (->) (,) () (,) () Identity -deriving via FromApplicative (Compose f g) instance (Applicative f, Applicative g) => Monoidal (->) (,) () (,) () (Compose f g) -deriving via FromApplicative [] instance Monoidal (->) (,) () (,) () [] -deriving via FromApplicative ZipList instance Monoidal (->) (,) () (,) () ZipList -deriving via FromApplicative NonEmpty instance Monoidal (->) (,) () (,) () NonEmpty -deriving via FromApplicative Maybe instance Monoidal (->) (,) () (,) () Maybe -deriving via FromApplicative (Either e) instance Monoidal (->) (,) () (,) () (Either e) -deriving via FromApplicative IO instance Monoidal (->) (,) () (,) () IO -deriving via FromApplicative (Product f g) instance (Applicative f, Applicative g) => Monoidal (->) (,) () (,) () (Product f g) -deriving via (FromApplicative ((,) x1)) instance (Monoid x1) => Monoidal (->) (,) () (,) () ((,) x1) -deriving via (FromApplicative ((,,) x1 x2)) instance (Monoid x1, Monoid x2) => Monoidal (->) (,) () (,) () ((,,) x1 x2) +deriving via FromApplicative Identity instance Monoidal (->) (,) () (,) () Identity + +deriving via FromApplicative (Compose f g) instance (Applicative f, Applicative g) => Monoidal (->) (,) () (,) () (Compose f g) + +deriving via FromApplicative [] instance Monoidal (->) (,) () (,) () [] + +deriving via FromApplicative ZipList instance Monoidal (->) (,) () (,) () ZipList + +deriving via FromApplicative NonEmpty instance Monoidal (->) (,) () (,) () NonEmpty + +deriving via FromApplicative Maybe instance Monoidal (->) (,) () (,) () Maybe + +deriving via FromApplicative (Either e) instance Monoidal (->) (,) () (,) () (Either e) + +deriving via FromApplicative IO instance Monoidal (->) (,) () (,) () IO + +deriving via FromApplicative (Product f g) instance (Applicative f, Applicative g) => Monoidal (->) (,) () (,) () (Product f g) + +deriving via (FromApplicative ((,) x1)) instance (Monoid x1) => Monoidal (->) (,) () (,) () ((,) x1) + +deriving via (FromApplicative ((,,) x1 x2)) instance (Monoid x1, Monoid x2) => Monoidal (->) (,) () (,) () ((,,) x1 x2) + deriving via (FromApplicative ((,,,) x1 x2 x3)) instance (Monoid x1, Monoid x2, Monoid x3) => Monoidal (->) (,) () (,) () ((,,,) x1 x2 x3) instance Alternative f => Monoidal (->) Either Void (,) () (FromAlternative f) -deriving via FromAlternative ZipList instance Monoidal (->) Either Void (,) () ZipList -deriving via FromAlternative STM instance Monoidal (->) Either Void (,) () STM -deriving via FromAlternative ReadP instance Monoidal (->) Either Void (,) () ReadP -deriving via FromAlternative ReadPrec instance Monoidal (->) Either Void (,) () ReadPrec -deriving via FromAlternative IO instance Monoidal (->) Either Void (,) () IO -deriving via FromAlternative Maybe instance Monoidal (->) Either Void (,) () Maybe -deriving via FromAlternative [] instance Monoidal (->) Either Void (,) () [] -deriving via FromAlternative (WrappedMonad m) instance (MonadPlus m) => Monoidal (->) Either Void (,) () (WrappedMonad m) -deriving via FromAlternative (ArrowMonad a) instance (ArrowPlus a) => Monoidal (->) Either Void (,) () (ArrowMonad a) +deriving via FromAlternative ZipList instance Monoidal (->) Either Void (,) () ZipList + +deriving via FromAlternative STM instance Monoidal (->) Either Void (,) () STM + +deriving via FromAlternative ReadP instance Monoidal (->) Either Void (,) () ReadP + +deriving via FromAlternative ReadPrec instance Monoidal (->) Either Void (,) () ReadPrec + +deriving via FromAlternative IO instance Monoidal (->) Either Void (,) () IO + +deriving via FromAlternative Maybe instance Monoidal (->) Either Void (,) () Maybe + +deriving via FromAlternative [] instance Monoidal (->) Either Void (,) () [] + +deriving via FromAlternative (WrappedMonad m) instance (MonadPlus m) => Monoidal (->) Either Void (,) () (WrappedMonad m) + +deriving via FromAlternative (ArrowMonad a) instance (ArrowPlus a) => Monoidal (->) Either Void (,) () (ArrowMonad a) + deriving via FromAlternative (Proxy :: Type -> Type) instance Monoidal (->) Either Void (,) () (Proxy :: Type -> Type) -deriving via FromAlternative (U1 :: Type -> Type) instance Monoidal (->) Either Void (,) () (U1 :: Type -> Type) -deriving via FromAlternative (WrappedArrow a b) instance (ArrowZero a, ArrowPlus a) => Monoidal (->) Either Void (,) () (WrappedArrow a b) -deriving via FromAlternative (Kleisli m a) instance (Alternative m) => Monoidal (->) Either Void (,) () (Kleisli m a) -deriving via FromAlternative (Ap f) instance (Alternative f) => Monoidal (->) Either Void (,) () (Ap f) -deriving via FromAlternative (Alt f) instance (Alternative f) => Monoidal (->) Either Void (,) () (Alt f) -deriving via FromAlternative (Rec1 f) instance (Alternative f) => Monoidal (->) Either Void (,) () (Rec1 f) -deriving via FromAlternative (Product f g) instance (Alternative f, Alternative g) => Monoidal (->) Either Void (,) () (Product f g) -deriving via FromAlternative (f :*: g) instance (Alternative f, Alternative g) => Monoidal (->) Either Void (,) () (f :*: g) -deriving via FromAlternative (f `Compose` g) instance (Alternative f, Applicative g) => Monoidal (->) Either Void (,) () (f `Compose` g) -deriving via FromAlternative (f :.: g) instance (Alternative f, Applicative g) => Monoidal (->) Either Void (,) () (f :.: g) -deriving via FromAlternative (M1 i c f) instance (Alternative f) => Monoidal (->) Either Void (,) () (M1 i c f) + +deriving via FromAlternative (U1 :: Type -> Type) instance Monoidal (->) Either Void (,) () (U1 :: Type -> Type) + +deriving via FromAlternative (WrappedArrow a b) instance (ArrowZero a, ArrowPlus a) => Monoidal (->) Either Void (,) () (WrappedArrow a b) + +deriving via FromAlternative (Kleisli m a) instance (Alternative m) => Monoidal (->) Either Void (,) () (Kleisli m a) + +deriving via FromAlternative (Ap f) instance (Alternative f) => Monoidal (->) Either Void (,) () (Ap f) + +deriving via FromAlternative (Alt f) instance (Alternative f) => Monoidal (->) Either Void (,) () (Alt f) + +deriving via FromAlternative (Rec1 f) instance (Alternative f) => Monoidal (->) Either Void (,) () (Rec1 f) + +deriving via FromAlternative (Product f g) instance (Alternative f, Alternative g) => Monoidal (->) Either Void (,) () (Product f g) + +deriving via FromAlternative (f :*: g) instance (Alternative f, Alternative g) => Monoidal (->) Either Void (,) () (f :*: g) + +deriving via FromAlternative (f `Compose` g) instance (Alternative f, Applicative g) => Monoidal (->) Either Void (,) () (f `Compose` g) + +deriving via FromAlternative (f :.: g) instance (Alternative f, Applicative g) => Monoidal (->) Either Void (,) () (f :.: g) + +deriving via FromAlternative (M1 i c f) instance (Alternative f) => Monoidal (->) Either Void (,) () (M1 i c f) + +deriving via FromDivisible Predicate instance Monoidal (->) (,) () (,) () Predicate + +deriving via FromDivisible Comparison instance Monoidal (->) (,) () (,) () Comparison + +deriving via FromDivisible Equivalence instance Monoidal (->) (,) () (,) () Equivalence + +deriving via FromDivisible (U1 :: Type -> Type) instance Monoidal (->) (,) () (,) () (U1 :: Type -> Type) + +deriving via FromDivisible (Op r) instance Monoid r => Monoidal (->) (,) () (,) () (Op r) + +-- deriving via FromDivisible (Proxy :: Type -> Type) instance Monoidal (->) (,) () (,) () (Proxy :: Type -> Type) +deriving via FromDivisible (MaybeT m) instance Divisible m => Monoidal (->) (,) () (,) () (MaybeT m) + +deriving via FromDivisible (Rec1 m) instance Divisible m => Monoidal (->) (,) () (,) () (Rec1 m) + +deriving via FromDivisible (Const m) instance Monoid m => Monoidal (->) (,) () (,) () (Const m :: Type -> Type) + +deriving via FromDivisible (Alt f) instance Divisible f => Monoidal (->) (,) () (,) () (Alt f) + +deriving via FromDivisible (Reverse f) instance Divisible f => Monoidal (->) (,) () (,) () (Reverse f) + +deriving via FromDivisible (Constant m) instance Monoid m => Monoidal (->) (,) () (,) () (Constant m :: Type -> Type) + +deriving via FromDivisible (WriterT w m) instance Divisible m => Monoidal (->) (,) () (,) () (WriterT w m) + +deriving via FromDivisible (Lazy.WriterT w m) instance Divisible m => Monoidal (->) (,) () (,) () (Lazy.WriterT w m) + +deriving via FromDivisible (StateT w m) instance Divisible m => Monoidal (->) (,) () (,) () (StateT w m) + +deriving via FromDivisible (Lazy.StateT w m) instance Divisible m => Monoidal (->) (,) () (,) () (Lazy.StateT w m) + +deriving via FromDivisible (ReaderT r m) instance Divisible m => Monoidal (->) (,) () (,) () (ReaderT r m) + +deriving via FromDivisible (IdentityT m) instance Divisible m => Monoidal (->) (,) () (,) () (IdentityT m) + +deriving via FromDivisible (ExceptT e m) instance Divisible m => Monoidal (->) (,) () (,) () (ExceptT e m) + +deriving via FromDivisible (Backwards f) instance Divisible f => Monoidal (->) (,) () (,) () (Backwards f) + +deriving via FromDivisible (ComposeCF f g) instance (Divisible f, Applicative g) => Monoidal (->) (,) () (,) () (ComposeCF f g) + +deriving via FromDivisible (ComposeFC f g) instance (Divisible g, Applicative f) => Monoidal (->) (,) () (,) () (ComposeFC f g) + +deriving via FromDivisible (f :*: g) instance (Divisible f, Divisible g) => Monoidal (->) (,) () (,) () (f :*: g) + +-- deriving via FromDivisible (Product f g) instance (Divisible f, Divisible g) => Monoidal (->) (,) () (,) () (Product f g) +deriving via FromDivisible (M1 i c f) instance Divisible f => Monoidal (->) (,) () (,) () (M1 i c f) + +deriving via FromDivisible (f :.: g) instance (Applicative f, Divisible g) => Monoidal (->) (,) () (,) () (f :.: g) + +-- deriving via FromDivisible (Compose f g) instance (Applicative f, Divisible g) => Monoidal (->) (,) () (,) () (Compose f g) +deriving via FromDivisible (RWST r w s m) instance (Divisible m) => Monoidal (->) (,) () (,) () (RWST r w s m) + +deriving via FromDivisible (Lazy.RWST r w s m) instance (Divisible m) => Monoidal (->) (,) () (,) () (Lazy.RWST r w s m) + +deriving via FromDecidable Predicate instance Monoidal (->) Either Void (,) () Predicate + +deriving via FromDecidable Comparison instance Monoidal (->) Either Void (,) () Comparison + +deriving via FromDecidable Equivalence instance Monoidal (->) Either Void (,) () Equivalence + +-- deriving via FromDecidable (U1 :: Type -> Type) instance Monoidal (->) Either Void (,) () (U1 :: Type -> Type) +deriving via FromDecidable (Op r) instance Monoid r => Monoidal (->) Either Void (,) () (Op r) + +-- deriving via FromDecidable (Proxy :: Type -> Type) instance Monoidal (->) Either Void (,) () (Proxy :: Type -> Type) +deriving via FromDecidable (MaybeT m) instance Decidable m => Monoidal (->) Either Void (,) () (MaybeT m) + +-- deriving via FromDecidable (Rec1 m) instance Decidable m => Monoidal (->) Either Void (,) () (Rec1 m) +-- deriving via FromDecidable (Alt f) instance Decidable f => Monoidal (->) Either Void (,) () (Alt f) +deriving via FromDecidable (Reverse f) instance Decidable f => Monoidal (->) Either Void (,) () (Reverse f) + +deriving via FromDecidable (WriterT w m) instance Decidable m => Monoidal (->) Either Void (,) () (WriterT w m) + +deriving via FromDecidable (Lazy.WriterT w m) instance Decidable m => Monoidal (->) Either Void (,) () (Lazy.WriterT w m) + +deriving via FromDecidable (StateT w m) instance Decidable m => Monoidal (->) Either Void (,) () (StateT w m) + +deriving via FromDecidable (Lazy.StateT w m) instance Decidable m => Monoidal (->) Either Void (,) () (Lazy.StateT w m) + +deriving via FromDecidable (ReaderT r m) instance Decidable m => Monoidal (->) Either Void (,) () (ReaderT r m) + +deriving via FromDecidable (IdentityT m) instance Decidable m => Monoidal (->) Either Void (,) () (IdentityT m) + +deriving via FromDecidable (Backwards f) instance Decidable f => Monoidal (->) Either Void (,) () (Backwards f) + +deriving via FromDecidable (ComposeFC f g) instance (Decidable g, Applicative f) => Monoidal (->) Either Void (,) () (ComposeFC f g) + +-- deriving via FromDecidable (f :*: g) instance (Decidable f, Decidable g) => Monoidal (->) Either Void (,) () (f :*: g) +-- deriving via FromDecidable (Product f g) instance (Decidable f, Decidable g) => Monoidal (->) Either Void (,) () (Product f g) +-- deriving via FromDecidable (M1 i c f) instance Decidable f => Monoidal (->) Either Void (,) () (M1 i c f) +-- deriving via FromDecidable (f :.: g) instance (Applicative f, Decidable g) => Monoidal (->) Either Void (,) () (f :.: g) +-- deriving via FromDecidable (Compose f g) instance (Applicative f, Decidable g) => Monoidal (->) Either Void (,) () (Compose f g) +deriving via FromDecidable (RWST r w s m) instance (Decidable m) => Monoidal (->) Either Void (,) () (RWST r w s m) + +deriving via FromDecidable (Lazy.RWST r w s m) instance (Decidable m) => Monoidal (->) Either Void (,) () (Lazy.RWST r w s m) diff --git a/src/Data/Trifunctor/Monoidal.hs b/src/Data/Trifunctor/Monoidal.hs --- a/src/Data/Trifunctor/Monoidal.hs +++ b/src/Data/Trifunctor/Monoidal.hs @@ -24,7 +24,7 @@ -- -- __Associativity:__ -- --- \[ +-- \[ -- \require{AMScd} -- \begin{CD} -- (F A B C \bullet F X Y Z) \bullet F P Q R @>>{\alpha_{\mathcal{D}}}> F A B C \bullet (F X Y Z \bullet F P Q R) \\ @@ -39,12 +39,14 @@ -- 'combine' 'Control.Category..' 'Control.Category.Tensor.grmap' 'Control.Category.Tensor.combine' 'Control.Category..' 'Control.Category.Tensor.bwd' 'Control.Category.Tensor.assoc' ≡ 'Data.Functor.fmap' ('Control.Category.Tensor.bwd' 'Control.Category.Tensor.assoc') 'Control.Category..' 'combine' 'Control.Category..' 'Control.Category.Tensor.glmap' 'combine' -- @ class - ( Associative cat t1 - , Associative cat t2 - , Associative cat t3 - , Associative cat to - ) => Semigroupal cat t1 t2 t3 to f where - -- | A natural transformation \(\phi_{ABC,XYZ} : F\ A\ B\ C \bullet F\ X\ Y\ Z \to F\ (A \otimes X)\ (B \otimes Y) (C \otimes Z)\). + ( Associative cat t1, + Associative cat t2, + Associative cat t3, + Associative cat to + ) => + Semigroupal cat t1 t2 t3 to f + where + -- | A natural transformation \(\phi_{ABC,XYZ} : F\ A\ B\ C \bullet F\ X\ Y\ Z \to F\ (A \otimes X)\ (B \otimes Y) (C \otimes Z)\). combine :: to (f x y z) (f x' y' z') `cat` f (t1 x x') (t2 y y') (t3 z z') -------------------------------------------------------------------------------- @@ -70,7 +72,7 @@ -- -- __Right Unitality:__ -- --- \[ +-- \[ -- \require{AMScd} -- \begin{CD} -- F A B C \bullet I_{\mathcal{D}} @>{1 \bullet \phi}>> F A B \bullet F I_{\mathcal{C_{1}}} I_{\mathcal{C_{2}}} I_{\mathcal{C_{3}}}\\ @@ -85,7 +87,7 @@ -- -- __ Left Unitality__: -- --- \[ +-- \[ -- \begin{CD} -- I_{\mathcal{D}} \bullet F A B C @>{\phi \bullet 1}>> F I_{\mathcal{C_{1}}} I_{\mathcal{C_{2}}} \bullet F A B C\\ -- @VV{\lambda_{\mathcal{D}}}V @VV{I_{\mathcal{C_{1}}}I_{\mathcal{C_{2}}}I_{\mathcal{C_{3}}},\phi ABC}V \\ @@ -97,10 +99,11 @@ -- 'combine' 'Control.Category..' 'Control.Category.Tensor.glmap' 'introduce' ≡ 'Data.Functor.fmap' ('Control.Category.Tensor.bwd' 'Control.Category.Tensor.unitl') 'Control.Category..' 'Control.Category.Tensor.fwd' 'Control.Category.Tensor.unitl' -- @ class - ( Tensor cat t1 i1 - , Tensor cat t2 i2 - , Tensor cat t3 i3 - , Tensor cat to io - , Semigroupal cat t1 t2 t3 to f - , Unital cat i1 i2 i3 io f - ) => Monoidal cat t1 i1 t2 i2 t3 i3 to io f + ( Tensor cat t1 i1, + Tensor cat t2 i2, + Tensor cat t3 i3, + Tensor cat to io, + Semigroupal cat t1 t2 t3 to f, + Unital cat i1 i2 i3 io f + ) => + Monoidal cat t1 i1 t2 i2 t3 i3 to io f