Snapshot

cabal.project

@@ -0,0 +1,6 @@
+packages: .
+
+source-repository-package
+  type: git
+  location: https://github.com/solomon-b/kindly-functors.git
+  tag: 26fdb99ef92124241e38e6f4511961ad2f9fb920

monoidal-functors.cabal

@@ -58,6 +58,7 @@ library
     comonad                       >= 5.0.8 && < 6,
     distributive                  >= 0.6.2 && < 0.7,
     contravariant                 >= 1.5.5 && < 1.6,
+    kindly-functors,
     profunctors                   >= 5.6.2 && < 5.7,
     semialign                     >= 1.3 && < 1.4,
     semigroupoids                 >= 6.0.0 && < 6.1,

overlay.nix

@@ -2,6 +2,12 @@ final: prev: {
   haskellPackages = prev.haskellPackages.override (old: {
     overrides = prev.lib.composeExtensions (old.overrides or (_: _: { }))
       (hfinal: hprev: {
+        kindly-functors = hfinal.callCabal2nix "kindly-functors" (prev.fetchFromGitHub {
+          owner = "solomon-b";
+          repo = "kindly-functors";
+          rev = "26fdb99ef92124241e38e6f4511961ad2f9fb920";
+          sha256 = "sha256-nZHERb1QA3XtRZWEcIoq8P4atOBioE7cRrJqrjkw9m0=";
+        }) {};
         monoidal-functors = (hfinal.callCabal2nix "monoidal-functors" ./. { }).overrideScope (hfinal': hprev': {
           bifunctors = hfinal.bifunctors_5_6_1;
           semigroupoids = hfinal.semigroupoids_6_0_0_1.overrideScope (hfinal': hprev': {

src/Control/Category/Tensor.hs

@@ -1,15 +1,10 @@
 {-# LANGUAGE MonoLocalBinds #-}
+{-# LANGUAGE ImpredicativeTypes #-}
 
 module Control.Category.Tensor
   ( -- * Iso
     Iso (..),
 
-    -- * GBifunctor
-    GBifunctor (..),
-    (#),
-    grmap,
-    glmap,
-
     -- * Associative
     Associative (..),
 
@@ -26,12 +21,14 @@ where
 import Control.Applicative (Applicative (..))
 import Control.Arrow (Kleisli (..))
 import Control.Category (Category (..))
-import Data.Biapplicative (Biapplicative (..), Bifunctor (..))
+import Data.Biapplicative (Biapplicative (..))
 import Data.Functor.Contravariant (Op (..))
 import Data.Profunctor (Profunctor (..), Star (..))
 import Data.These (These (..), these)
 import Data.Void (Void, absurd)
 import Prelude hiding (Applicative (..), id, (.))
+import qualified Kindly
+import Kindly (type (~>))
 
 --------------------------------------------------------------------------------
 
@@ -54,82 +51,6 @@ instance (Category cat) => Category (Iso cat) where
 
 --------------------------------------------------------------------------------
 
--- | A Bifunctor @t@ is a 'Functor' whose domain is the product of two
--- categories. 'GBifunctor' is equivalent to the ordinary
--- 'Data.Bifunctor.Bifunctor' class but we replace the implicit '(->)' 'Category' with
--- three distinct higher kinded variables @cat1@, @cat2@, and @cat3@ allowing the user
--- to pickout a functor from \(cat_1 \times cat_2\) to \(cat_3\).
---
--- === Laws
---
--- @
--- 'gbimap' 'id' 'id' ≡ 'id'
--- 'grmap' 'id' ≡ 'id'
--- 'glmap' 'id' ≡ 'id'
---
--- 'gbimap' (f '.' g) (h '.' i) ≡ 'gbimap' f h '.' 'gbimap' g i
--- 'grmap' (f '.' g) ≡ 'grmap' f '.' 'grmap' g
--- 'glmap' (f '.' g) ≡ 'glmap' f '.' 'glmap' g
--- @
-class (Category cat1, Category cat2, Category cat3) => GBifunctor cat1 cat2 cat3 t | t cat3 -> cat1 cat2 where
-  -- | Covariantly map over both variables.
-  --
-  -- @'gbimap' f g ≡ 'glmap' f '.' 'grmap' g@
-  --
-  -- ==== __Examples__
-  -- >>> gbimap @(->) @(->) @(->) @(,) show not (123, False)
-  -- ("123",True)
-  --
-  -- >>> gbimap @(->) @(->) @(->) @Either show not (Right False)
-  -- Right True
-  --
-  -- >>> 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)
-
--- | Infix operator for 'gbimap'.
-infixr 9 #
-
-(#) :: (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.
-grmap :: (GBifunctor cat1 cat2 cat3 t) => cat2 c d -> cat3 (a `t` c) (a `t` d)
-grmap = (#) id
-
--- | Covariantally map over the left variable.
-glmap :: (GBifunctor cat1 cat2 cat3 t) => cat1 a b -> cat3 (a `t` c) (b `t` c)
-glmap = flip (#) id
-
-instance (GBifunctor (->) (->) (->) t) => GBifunctor Op Op Op t where
-  gbimap :: Op a b -> Op c d -> Op (t a c) (t b d)
-  gbimap (Op f) (Op g) = Op $ gbimap f g
-
-instance (Bifunctor t) => GBifunctor (->) (->) (->) t where
-  gbimap = bimap
-
-instance GBifunctor (Star Maybe) (Star Maybe) (Star Maybe) These where
-  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
-      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))
-
---------------------------------------------------------------------------------
-
 -- | A bifunctor \(\_\otimes\_: \mathcal{C} \times \mathcal{C} \to \mathcal{C}\) is
 -- 'Associative' if it is equipped with a
 -- <https://ncatlab.org/nlab/show/natural+isomorphism natural isomorphism> of the form
@@ -142,7 +63,7 @@ instance (GBifunctor cat cat cat t) => GBifunctor (Iso cat) (Iso cat) (Iso cat)
 -- 'fwd' 'assoc' '.' 'bwd' 'assoc' ≡ 'id'
 -- 'bwd' 'assoc' '.' 'fwd' 'assoc' ≡ 'id'
 -- @
-class (Category cat, GBifunctor cat cat cat t) => Associative cat t where
+class (Category cat, Kindly.FunctorOf cat (cat ~> cat) t) => Associative cat t where
   -- | The <https://ncatlab.org/nlab/show/natural+isomorphism natural isomorphism> between left and
   -- right associated nestings of @t@.
   --
@@ -159,8 +80,8 @@ 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
+      { fwd = _, -- Op $ bwd assoc,
+        bwd = _ -- Op $ fwd assoc
       }
 
 instance Associative (->) (,) where
@@ -187,15 +108,15 @@ instance Associative (->) These where
         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
+instance (Monad m, Associative (->) t, Kindly.Bifunctor (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)
       }
 
-instance (Monad m, Associative (->) t, GBifunctor (Kleisli m) (Kleisli m) (Kleisli m) t) => Associative (Kleisli m) t where
+instance (Monad m, Associative (->) t, Kindly.Bifunctor (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

src/Data/Trifunctor/Monoidal.hs

@@ -101,27 +101,27 @@ infixr 9 |**&|
 
 infixr 9 |*+*|
 
-(|*+*|) :: (Semigroupal (->) (,) Either (,) (,) p) => p a b c -> p a' b c' -> p (a, a') (Either b b) (c, c')
+(|*+*|) :: (Semigroupal (->) (,) Either (,) (,) p) => p a b c -> p a' b' c' -> p (a, a') (Either b b') (c, c')
 (|*+*|) = curry combine
 
 infixr 9 |*++|
 
-(|*++|) :: (Semigroupal (->) (,) Either Either (,) p) => p a b c -> p a' b c' -> p (a, a') (Either b b) (Either c c')
+(|*++|) :: (Semigroupal (->) (,) Either Either (,) p) => p a b c -> p a' b' c' -> p (a, a') (Either b b') (Either c c')
 (|*++|) = curry combine
 
 infixr 9 |*+&|
 
-(|*+&|) :: (Semigroupal (->) (,) Either These (,) p) => p a b c -> p a' b c' -> p (a, a') (Either b b) (These c c')
+(|*+&|) :: (Semigroupal (->) (,) Either These (,) p) => p a b c -> p a' b' c' -> p (a, a') (Either b b') (These c c')
 (|*+&|) = curry combine
 
 infixr 9 |*&*|
 
-(|*&*|) :: (Semigroupal (->) (,) These (,) (,) p) => p a b c -> p a' b c' -> p (a, a') (These b b) (c, c')
+(|*&*|) :: (Semigroupal (->) (,) These (,) (,) p) => p a b c -> p a' b' c' -> p (a, a') (These b b') (c, c')
 (|*&*|) = curry combine
 
 infixr 9 |*&+|
 
-(|*&+|) :: (Semigroupal (->) (,) These Either (,) p) => p a b c -> p a' b c' -> p (a, a') (These b b) (Either c c')
+(|*&+|) :: (Semigroupal (->) (,) These Either (,) p) => p a b c -> p a' b' c' -> p (a, a') (These b b') (Either c c')
 (|*&+|) = curry combine
 
 infixr 9 |*&&|
@@ -131,22 +131,22 @@ infixr 9 |*&&|
 
 infixr 9 |+**|
 
-(|+**|) :: (Semigroupal (->) Either (,) (,) (,) p) => p a b c -> p a' b c' -> p (Either a a') (b, b) (c, c')
+(|+**|) :: (Semigroupal (->) Either (,) (,) (,) p) => p a b c -> p a' b' c' -> p (Either a a') (b, b') (c, c')
 (|+**|) = curry combine
 
 infixr 9 |+*+|
 
-(|+*+|) :: (Semigroupal (->) Either (,) Either (,) p) => p a b c -> p a' b c' -> p (Either a a') (b, b) (Either c c')
+(|+*+|) :: (Semigroupal (->) Either (,) Either (,) p) => p a b c -> p a' b' c' -> p (Either a a') (b, b') (Either c c')
 (|+*+|) = curry combine
 
 infixr 9 |+*&|
 
-(|+*&|) :: (Semigroupal (->) Either (,) These (,) p) => p a b c -> p a' b c' -> p (Either a a') (b, b) (These c c')
+(|+*&|) :: (Semigroupal (->) Either (,) These (,) p) => p a b c -> p a' b' c' -> p (Either a a') (b, b') (These c c')
 (|+*&|) = curry combine
 
 infixr 9 |++*|
 
-(|++*|) :: (Semigroupal (->) Either Either (,) (,) p) => p a b c -> p a' b c' -> p (Either a a') (Either b b) (c, c')
+(|++*|) :: (Semigroupal (->) Either Either (,) (,) p) => p a b c -> p a' b' c' -> p (Either a a') (Either b b') (c, c')
 (|++*|) = curry combine
 
 infixr 9 |+++|
@@ -156,17 +156,17 @@ infixr 9 |+++|
 
 infixr 9 |++&|
 
-(|++&|) :: (Semigroupal (->) Either Either These (,) p) => p a b c -> p a' b c' -> p (Either a a') (Either b b) (These c c')
+(|++&|) :: (Semigroupal (->) Either Either These (,) p) => p a b c -> p a' b' c' -> p (Either a a') (Either b b') (These c c')
 (|++&|) = curry combine
 
 infixr 9 |+&*|
 
-(|+&*|) :: (Semigroupal (->) Either These (,) (,) p) => p a b c -> p a' b c' -> p (Either a a') (These b b) (c, c')
+(|+&*|) :: (Semigroupal (->) Either These (,) (,) p) => p a b c -> p a' b' c' -> p (Either a a') (These b b') (c, c')
 (|+&*|) = curry combine
 
 infixr 9 |+&+|
 
-(|+&+|) :: (Semigroupal (->) Either These Either (,) p) => p a b c -> p a' b c' -> p (Either a a') (These b b) (Either c c')
+(|+&+|) :: (Semigroupal (->) Either These Either (,) p) => p a b c -> p a' b' c' -> p (Either a a') (These b b') (Either c c')
 (|+&+|) = curry combine
 
 infixr 9 |+&&|