packages feed

squares 0.0.1 → 0.1

raw patch · 14 files changed

+433/−80 lines, 14 filesdep +adjunctionsdep +comonaddep +distributivedep ~base

Dependencies added: adjunctions, comonad, distributive

Dependency ranges changed: base

Files

CHANGELOG.md view
@@ -1,5 +1,16 @@ # Revision history for squares +## 0.1++* `mkSquare` works for all functions of the right shape+* Added `runSquare`, the inverse of `mkSquare`.+* Added `Data.Functor.Square`+* Added `Data.Foldable.Square`+* Added `Data.Distributive.Square`+* Added `Data.Functor.Rep.Square`+* Added `Data.Functor.Adjunction.Square`+* Added `Control.Comonad.Square`+ ## 0.0.1 -- 2020-05-23  * Included README.
squares.cabal view
@@ -1,9 +1,11 @@ cabal-version:       >=1.10  name:                squares-version:             0.0.1+version:             0.1 synopsis:            The double category of Hask functors and profunctors-description:         A library for working with natural transformations of type @forall a b. p a b -> q (f a) (g b)@.+description:         A library for working with natural transformations of type+                     .+                     @forall a b. p a b -> q (f a) (g b)@ homepage:            https://github.com/sjoerdvisscher/squares bug-reports:         https://github.com/sjoerdvisscher/squares/issues license:             BSD3@@ -22,10 +24,20 @@                        Data.Functor.Compose.List                        Data.Profunctor.Composition.List                        Control.Arrow.Square+                       Control.Comonad.Square                        Control.Monad.Square+                       Data.Distributive.Square+                       Data.Foldable.Square+                       Data.Functor.Square                        Data.Profunctor.Square                        Data.Traversable.Square-  build-depends:       base == 4.*, profunctors == 5.*+                       Data.Functor.Adjunction.Square+                       Data.Functor.Rep.Square+  build-depends:       base >= 4.8 && < 5+                     , profunctors == 5.*+                     , distributive == 0.6.*+                     , adjunctions == 4.*+                     , comonad == 5.*   hs-source-dirs:      src   default-language:    Haskell2010 
src/Control/Arrow/Square.hs view
@@ -10,8 +10,8 @@ module Control.Arrow.Square where  import Data.Square-import Data.Functor.Compose.List import Data.Profunctor+import Data.Profunctor.Composition import Data.Profunctor.Composition.List import qualified Control.Arrow as A @@ -21,8 +21,8 @@ -- > |  @--a -- > |     | -- > +-----+-arr :: A.Arrow a => Square '[] '[a] '[] '[]-arr = Square (P . A.arr . dimap unId Id . unHom)+arr :: (A.Arrow a, Profunctor a) => Square '[] '[a] '[] '[]+arr = mkSquare A.arr  -- | -- > +-----+@@ -30,8 +30,8 @@ -- > |  @--a -- > a--/  | -- > +-----+-(>>>) :: A.Arrow a => Square '[a, a] '[a] '[] '[]-(>>>) = Square (\(PComp p (P q)) -> P (A.arr Id A.<<< q A.<<< p A.<<< A.arr unId))+(>>>) :: (A.Arrow a, Profunctor a) => Square '[a, a] '[a] '[] '[]+(>>>) = mkSquare (\(Procompose q p) -> p A.>>> q)  -- | -- > +-_⊗d-+@@ -39,8 +39,8 @@ -- > a--@--a -- > |  v  | -- > +-_⊗d-+-second :: A.Arrow a => Square '[a] '[a] '[(,) d] '[(,) d]-second = Square (P . (A.>>> A.arr F) . (A.<<< A.arr unF) . A.second . unP)+second :: (A.Arrow a, Profunctor a) => Square '[a] '[a] '[(,) d] '[(,) d]+second = mkSquare A.second  -- | -- > H²-⊗--H@@ -57,8 +57,8 @@ -- > a--@--a -- > |  v  | -- > +-_⊕d-+-right :: A.ArrowChoice a => Square '[a] '[a] '[Either d] '[Either d]-right = Square (P . (A.>>> A.arr F) . (A.<<< A.arr unF) . A.right . unP)+right :: (A.ArrowChoice a, Profunctor a) => Square '[a] '[a] '[Either d] '[Either d]+right = mkSquare A.right  -- | -- > H²-⊕--H
+ src/Control/Comonad/Square.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE DataKinds #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Comonad.Square+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  sjoerd@w3future.com+--+-----------------------------------------------------------------------------+module Control.Comonad.Square where++import Data.Square+import Data.Profunctor+import qualified Control.Comonad as W++-- |+-- > +--w--++-- > |  v  |+-- > |  X  |+-- > |     |+-- > +-----++extract :: W.Comonad w => Square '[] '[] '[w] '[]+extract = mkSquare (. W.extract)++-- |+-- > +--w--++-- > |  v  |+-- > w<-E  |+-- > |  v  |+-- > +--w--++--+-- `W.extend` as a square+--+-- Right identity law:+--+-- > +--w--++-- > |  v  |     +--w--++-- > w<-E  |     |  v  |+-- > |  v  | === w<-/  |+-- > |  X  |     |     |+-- > +-----+     +-----++--+-- Left identity law:+--+-- > +---w-++-- > |   v |     +--w--++-- > | /-E |     |  |  |+-- > | v | | === |  v  |+-- > | X v |     |  |  |+-- > +---w-+     +--w--++--+-- Associativity law:+--+-- > +--w--+     +---w-++-- > |  v  |     |   v |+-- > w<-E  |     | /-E |+-- > |  v  | === w<E | |+-- > w<-E  |     | | | |+-- > |  v  |     w</ v |+-- > +--w--+     +---w-++extend :: W.Comonad w => Square '[Costar w] '[] '[w] '[w]+extend = mkSquare (W.extend . runCostar)++-- |+-- > +---w-++-- > |   v |+-- > | /-@ |+-- > | v v |+-- > +-w-w-++--+-- > duplicate = fromRight ||| extend+duplicate :: W.Comonad w => Square '[] '[] '[w] '[w, w]+duplicate = fromRight ||| extend++-- |+-- > +-----++-- > |  /-<w+-- > w<-@  |+-- > w<-/  |+-- > +-----++--+-- Cokleisli composition `(W.<=<)`+--+-- > (<=<) = fromRight === extend === toLeft+(<=<) :: W.Comonad w => Square '[Costar w, Costar w] '[Costar w] '[] '[]+(<=<) = fromRight === extend === toLeft
src/Control/Monad/Square.hs view
@@ -11,17 +11,16 @@ import Prelude hiding (return) import Data.Square import Data.Profunctor-import Data.Profunctor.Square import qualified Control.Monad as M  -- | -- > +-----+ -- > |     |--- > |  R->m--- > |     |--- > +-----+-return :: Monad m => Square '[] '[Star m] '[] '[]-return = toHom ||| proNat (Star . (M.return .))+-- > |  R  |+-- > |  v  |+-- > +--m--++return :: Monad m => Square '[] '[] '[] '[m]+return = mkSquare (M.return .)  -- | -- > +--m--+@@ -30,36 +29,37 @@ -- > |  v  | -- > +--m--+ ----- `(>>=)`+-- `(>>=)` as a square (or to be precise its flipped version `(=<<)`) -- -- Left identity law: ----- > +-------+--- > | R>-\  +     +-----+--- > |    v  |     |     |--- > m>---B  | === m>-\  |--- > |    v  |     |  v  |--- > +----m--+     +--m--++-- > +-----++-- > |  R  |     +-----++-- > |  v  |     |     |+-- > m>-B  | === m>-\  |+-- > |  v  |     |  v  |+-- > +--m--+     +--m--+ -- -- Right identity law: ----- > +----m--+     +--m--+--- > |    v  |     |  |  |--- > | R>-B  | === |  v  |--- > |    v  |     |  |  |--- > +----m--+     +--m--++-- > +---m-++-- > | R v |     +--m--++-- > | v | |     |  |  |+-- > | \-B | === |  v  |+-- > |   v |     |  |  |+-- > +---m-+     +--m--+ -- -- Associativity law: ----- > +--m--+     +-----m--+--- > |  v  |     m>-\  v  |--- > m>-B  |     |  v  |  |--- > |  v  | === m>-B  |  |--- > m>-B  |     |  \->B  |--- > |  v  |     |     v  |--- > +--m--+     +-----m--++-- > +--m--+     +---m-++-- > |  v  |     m>\ v |+-- > m>-B  |     | v | |+-- > |  v  | === m>B | |+-- > m>-B  |     | \-B |+-- > |  v  |     |   v |+-- > +--m--+     +---m-+ bind :: Monad m => Square '[Star m] '[] '[m] '[m]-bind = mkSquare (flip (>>=) . runStar) ||| fromHom+bind = mkSquare (flip (>>=) . runStar)  -- | -- > +-m-m-+@@ -68,7 +68,7 @@ -- > |   v | -- > +---m-+ ----- @join = toRight ||| bind@+-- > join = toRight ||| bind join :: Monad m => Square '[] '[] '[m, m] '[m] join = toRight ||| bind @@ -80,5 +80,7 @@ -- > +-----+ -- -- Kleisli composition `(M.>=>)`-kleisli :: Monad m => Square '[Star m, Star m] '[Star m] '[] '[]-kleisli = fromLeft === bind === toRight+--+-- > (>=>) = fromLeft === bind === toRight+(>=>) :: Monad m => Square '[Star m, Star m] '[Star m] '[] '[]+(>=>) = fromLeft === bind === toRight
+ src/Data/Distributive/Square.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE DataKinds #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Distributive.Square+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  sjoerd@w3future.com+--+-----------------------------------------------------------------------------+module Data.Distributive.Square where++import Data.Square+import Data.Profunctor+import qualified Data.Distributive as D++-- |+-- > +--t--++-- > |  v  |+-- > f<-@-<f+-- > |  v  |+-- > +--t--++--+-- @cotraverse = (funId ||| fromRight) === distribute === (toLeft ||| funId)@+cotraverse :: (D.Distributive t, Functor f) => Square '[Costar f] '[Costar f] '[t] '[t]+cotraverse = mkSquare (Costar . D.cotraverse . runCostar)++-- |+-- > +---t-f-++-- > |   v v |+-- > | /-@-/ |+-- > | v v   |+-- > +-f-t---++--+-- @distribute = fromRight ||| cotraverse ||| toLeft@+distribute :: (D.Distributive t, Functor f) => Square '[] '[] '[t, f] '[f, t]+distribute = fromRight ||| cotraverse ||| toLeft
+ src/Data/Foldable/Square.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE DataKinds #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Foldable.Square+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  sjoerd@w3future.com+--+-----------------------------------------------------------------------------+module Data.Foldable.Square where++import Data.Square+import Data.Profunctor+import Data.Functor.Compose.List+import qualified Data.Foldable as F++-- |+-- > +--f--++-- > |  v  |+-- > !m-@-!m+-- > |  ?  |+-- > +--?--++--+-- `F.foldMap` as a square. Note that because `Forget` ignores its output parameter,+-- this square can have any list of functors as output type.+foldMap :: (Foldable f, Monoid m, IsFList gs) => Square '[Forget m] '[Forget m] '[f] gs+foldMap = mkSquare (Forget . F.foldMap . runForget)
+ src/Data/Functor/Adjunction/Square.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE DataKinds #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Functor.Adjunction.Square+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  sjoerd@w3future.com+--+-----------------------------------------------------------------------------+module Data.Functor.Adjunction.Square where++import Data.Square+import Data.Profunctor+import qualified Data.Functor.Adjunction as A++-- |+-- > +-----++-- > |     |+-- > f<-@->g+-- > |     |+-- > +-----++--+-- > leftAdjunct = unit === (toLeft ||| toRight)+leftAdjunct :: A.Adjunction f g => Square '[Costar f] '[Star g] '[] '[]+leftAdjunct = mkSquare (Star . A.leftAdjunct . runCostar)++-- |+-- > +-----++-- > |     |+-- > g>-@-<f+-- > |     |+-- > +-----++--+-- > rightAdjunct = (fromLeft ||| fromRight) === counit+rightAdjunct :: A.Adjunction f g => Square '[Star g] '[Costar f] '[] '[]+rightAdjunct = mkSquare (Costar . A.rightAdjunct . runStar)++-- |+-- > +-----++-- > |     |+-- > | /@\ |+-- > | v v |+-- > +-f-g-++--+-- > unit = fromRight ||| leftAdj ||| fromLeft+unit :: A.Adjunction f g => Square '[] '[] '[] '[f, g]+unit = mkSquare (A.unit .)++-- |+-- > +-g-f-++-- > | v v |+-- > | \@/ |+-- > |     |+-- > +-----++--+-- > counit = toRight ||| rightAdjoint ||| toLeft+counit :: A.Adjunction f g => Square '[] '[] '[g, f] '[]+counit = mkSquare (. A.counit)
src/Data/Functor/Compose/List.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE FlexibleContexts #-}@@ -32,24 +33,40 @@ instance (Functor f, Functor (FList (g ': gs))) => Functor (FList (f ': g ': gs)) where   fmap f = FComp . fmap (fmap f) . unFComp +-- | Calculate the simplified type of the composition of a list of functors.+type family PlainF (fs :: [* -> *]) (a :: *) :: *+type instance PlainF '[] a = a+type instance PlainF (f ': fs) a = PlainF fs (f a) --- | Combining and splitting nested `FList`s.-class FAppend f where-  fappend :: Functor (FList g) => FList g (FList f a) -> FList (f ++ g) a-  funappend :: Functor (FList g) => FList (f ++ g) a -> FList g (FList f a)-instance FAppend '[] where+-- | Functions for working with `FList`s.+class IsFList fs where+  -- | Combine 2 nested `FList`s into one `FList`.+  fappend :: Functor (FList gs) => FList gs (FList fs a) -> FList (fs ++ gs) a+  -- | Split one `FList` into 2 nested `FList`s.+  funappend :: Functor (FList gs) => FList (fs ++ gs) a -> FList gs (FList fs a)+  -- | Convert an `FList` to its simplified form.+  toPlainF :: FList fs a -> PlainF fs a+  -- | Create an `FList` from its simplified form.+  fromPlainF :: PlainF fs a -> FList fs a+instance IsFList '[] where   fappend = fmap unId   funappend = fmap Id-instance FAppend '[f] where+  toPlainF (Id a) = a+  fromPlainF a = Id a+instance IsFList '[f] where   fappend (Id fa) = F (unF fa)   fappend f@F{} = FComp $ fmap unF f   fappend f@FComp{} = FComp $ fmap unF f   funappend fa@F{} = Id fa   funappend (FComp fga@F{}) = fmap F fga   funappend (FComp fga@FComp{}) = fmap F fga-instance (Functor f, FAppend (g ': gs)) => FAppend (f ': g ': gs) where+  toPlainF (F fa) = fa+  fromPlainF fa = F fa+instance IsFList (g ': gs) => IsFList (f ': g ': gs) where   fappend = FComp . fappend . fmap unFComp   funappend = fmap FComp . funappend . unFComp+  toPlainF (FComp fgs) = toPlainF fgs+  fromPlainF fgs = FComp (fromPlainF fgs)   -- | Natural transformations between two functors. (Why is this still not in base??)
+ src/Data/Functor/Rep/Square.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE DataKinds #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Functor.Rep.Square+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  sjoerd@w3future.com+--+-----------------------------------------------------------------------------+module Data.Functor.Rep.Square where++import Data.Square+import qualified Data.Functor.Rep as R++-- |+-- > +-k→_-++-- > |  v  |+-- > |  @  |+-- > |  v  |+-- > +--f--++tabulate :: R.Representable f => Square '[] '[] '[(->) (R.Rep f)] '[f]+tabulate = funNat R.tabulate++-- |+-- > +--f--++-- > |  v  |+-- > |  @  |+-- > |  v  |+-- > +-k→_-++index :: R.Representable f => Square '[] '[] '[f] '[(->) (R.Rep f)]+index = funNat R.index
+ src/Data/Functor/Square.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE DataKinds #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Functor.Square+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  sjoerd@w3future.com+--+-----------------------------------------------------------------------------+module Data.Functor.Square where++import Data.Square+import Data.Functor.Identity+import Data.Functor.Compose++-- * Squares for @Identity@++-- |+-- >  +--I--++-- >  |  v  |+-- >  |  @  |+-- >  |     |+-- >  +-----++fromIdentity :: Square '[] '[] '[Identity] '[]+fromIdentity = mkSquare (. runIdentity)++-- |+-- > +-----++-- > |     |+-- > |  @  |+-- > |  v  |+-- > +--I--++toIdentity :: Square '[] '[] '[] '[Identity]+toIdentity = mkSquare (Identity .)++-- * Squares for `Compose`++-- |+-- >  +-g.f-++-- >  |  v  |+-- >  | /@\ |+-- >  | v v |+-- >  +-f-g-++fromCompose :: (Functor f, Functor g) => Square '[] '[] '[Compose g f] '[f, g]+fromCompose = mkSquare ((. getCompose) . fmap . fmap)++-- |+-- >  +-f-g-++-- >  | v v |+-- >  | \@/ |+-- >  |  v  |+-- >  +-g.f-++toCompose :: (Functor f, Functor g) => Square '[] '[] '[f, g] '[Compose g f]+toCompose = mkSquare ((Compose .) . fmap . fmap)
src/Data/Profunctor/Composition/List.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE FlexibleContexts #-}@@ -30,19 +31,37 @@ instance (Profunctor p, Profunctor (PList (q ': qs))) => Profunctor (PList (p ': q ': qs)) where   dimap l r (PComp p ps) = PComp (lmap l p) (rmap r ps) --- | Combining and splitting nested `PList`s.-class PAppend p where-  pappend :: Profunctor (PList q) => Procompose (PList q) (PList p) a b -> PList (p ++ q) a b-  punappend :: PList (p ++ q) a b -> Procompose (PList q) (PList p) a b-instance PAppend '[] where+-- | Calculate the simplified type of the composition of a list of profunctors.+type family PlainP (ps :: [* -> * -> *]) :: * -> * -> *+type instance PlainP '[] = (->)+type instance PlainP '[p] = p+type instance PlainP (p ': q ': qs) = Procompose (PlainP (q ': qs)) p++-- | Functions for working with `PList`s.+class IsPList ps where+  -- | Combine 2 nested `PList`s into one `PList`.+  pappend :: Profunctor (PList qs) => Procompose (PList qs) (PList ps) :-> PList (ps ++ qs)+  -- | Split one `PList` into 2 nested `PList`s.+  punappend :: PList (ps ++ qs) :-> Procompose (PList qs) (PList ps)+  -- | Convert a `PList` to its simplified form.+  toPlainP :: PList ps :-> PlainP ps+  -- | Create a `PList` from its simplified form.+  fromPlainP :: PlainP ps :-> PList ps+instance IsPList '[] where   pappend (Procompose q (Hom f)) = lmap f q   punappend q = Procompose q (Hom id)-instance Profunctor p => PAppend '[p] where+  toPlainP (Hom f) = f+  fromPlainP f = Hom f+instance Profunctor p => IsPList '[p] where   pappend (Procompose (Hom f) (P p)) = P (rmap f p)   pappend (Procompose q@P{} (P p)) = PComp p q   pappend (Procompose q@PComp{} (P p)) = PComp p q   punappend p@P{} = Procompose (Hom id) p   punappend (PComp p qs) = Procompose qs (P p)-instance (Profunctor p, PAppend (q ': qs)) => PAppend (p ': q ': qs) where+  toPlainP (P p) = p+  fromPlainP p = P p+instance IsPList (q ': qs) => IsPList (p ': q ': qs) where   pappend (Procompose q (PComp p ps)) = PComp p (pappend (Procompose q ps))   punappend (PComp p pq) = case punappend pq of Procompose q ps -> Procompose q (PComp p ps)+  toPlainP (PComp p pq) = Procompose (toPlainP pq) p+  fromPlainP (Procompose pq p) = PComp p (fromPlainP pq)
src/Data/Profunctor/Square.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE GADTs #-} {-# LANGUAGE DataKinds #-} ----------------------------------------------------------------------------- -- |@@ -10,8 +9,6 @@ module Data.Profunctor.Square where  import Data.Square-import Data.Functor.Compose.List-import Data.Profunctor.Composition.List import qualified Data.Profunctor as P import Data.Profunctor.Composition @@ -62,7 +59,7 @@ -- >  |     | -- >  +-----+ fromHom :: Square '[(->)] '[] '[] '[]-fromHom = Square (Hom . P.dimap unId Id . unP)+fromHom = mkSquare id  -- | -- > +-----+@@ -71,7 +68,7 @@ -- > |     | -- > +-----+ toHom :: Square '[] '[(->)] '[] '[]-toHom = Square (P . P.dimap unId Id . unHom)+toHom = mkSquare id  -- * Squares for `Procompose` @@ -82,7 +79,7 @@ -- >  |   \-q -- >  +-----+ fromProcompose :: (P.Profunctor p, P.Profunctor q) => Square '[Procompose q p] '[p, q] '[] '[]-fromProcompose = Square ((\(Procompose q p) -> PComp (P.lmap unId p) (P (P.rmap Id q))) . unP)+fromProcompose = mkSquare id  -- | -- >  +-----+@@ -91,4 +88,4 @@ -- >  q-/   | -- >  +-----+ toProcompose :: (P.Profunctor p, P.Profunctor q) => Square '[p, q] '[Procompose q p] '[] '[]-toProcompose = Square (P . (\(PComp p (P q)) -> Procompose (P.rmap Id q) (P.lmap unId p)))+toProcompose = mkSquare id
src/Data/Square.hs view
@@ -45,7 +45,7 @@ -- -- The empty square is the identity transformation. emptySquare :: Square '[] '[] '[] '[]-emptySquare = Square (dimap unId Id)+emptySquare = mkSquare id  -- | -- > +-----+@@ -61,7 +61,7 @@ -- Note that `emptySquare` is `proId` for the profunctor @(->)@. -- We don't draw a line for @(->)@ because it is the identity for profunctor composition. proId :: Profunctor p => Square '[p] '[p] '[] '[]-proId = Square (dimap unId Id)+proId = mkSquare id  -- | -- > +--f--+@@ -77,7 +77,7 @@ -- -- We don't draw lines for the identity functor, because it is the identity for functor composition. funId :: Functor f => Square '[] '[] '[f] '[f]-funId = Square (Hom . fmap . unHom)+funId = mkSquare fmap  -- | -- > +--f--+@@ -93,7 +93,7 @@ -- @forall a. f a -> g a@. The type above you get when `fmap`ping before or after. -- (It doesn't matter which, because of naturality!) funNat :: (Functor f, Functor g) => (f ~> g) -> Square '[] '[] '[f] '[g]-funNat n = Square (Hom . dimap unF F . (.) n . fmap . unHom)+funNat n = mkSquare ((n .) . fmap)  -- | -- > +-----+@@ -106,7 +106,7 @@ -- -- Natural transformations between profunctors. proNat :: (Profunctor p, Profunctor q) => (p :-> q) -> Square '[p] '[q] '[] '[]-proNat n = Square (P . dimap unId Id . n . unP)+proNat n = mkSquare n  -- | -- > +--f--+@@ -135,11 +135,20 @@ -- > PList '[p, q, r] a b ~ (p a x, q x y, r y b) type Square ps qs fs gs = SquareNT (PList ps) (PList qs) (FList fs) (FList gs) --- | A helper function to add the wrappers needed for `PList` and `FList`,--- if the square has exactly one (pro)functor on each side (which is common).-mkSquare :: Profunctor q => (forall a b. p a b -> q (f a) (g b)) -> Square '[p] '[q] '[f] '[g]-mkSquare f = Square (P . dimap unF F . f . unP)+-- | A helper function to add the wrappers needed for `PList` and `FList`.+mkSquare+  :: (IsPList ps, IsPList qs, IsFList fs, IsFList gs, Profunctor (PList qs))+  => (forall a b. PlainP ps a b -> PlainP qs (PlainF fs a) (PlainF gs b))+  -> Square ps qs fs gs -- ^+mkSquare n = Square (dimap toPlainF fromPlainF . dimap toPlainP fromPlainP n) +-- | A helper function to remove the wrappers needed for `PList` and `FList`.+runSquare+  :: (IsPList ps, IsPList qs, IsFList fs, IsFList gs, Profunctor (PList qs))+  => Square ps qs fs gs+  -> PlainP ps a b -> PlainP qs (PlainF fs a) (PlainF gs b) -- ^+runSquare (Square n) = dimap fromPlainP toPlainP (dimap fromPlainF toPlainF . n)+ -- | -- > +--f--+     +--h--+       +--f--h--+ -- > |  v  |     |  v  |       |  v  v  |@@ -150,7 +159,7 @@ -- Horizontal composition of squares. `proId` is the identity of `(|||)`. -- This is regular function composition of the underlying functions. infixl 6 |||-(|||) :: (Profunctor (PList rs), FAppend fs, FAppend gs, Functor (FList hs), Functor (FList is))+(|||) :: (Profunctor (PList rs), IsFList fs, IsFList gs, Functor (FList hs), Functor (FList is))       => Square ps qs fs gs -> Square qs rs hs is -> Square ps rs (fs ++ hs) (gs ++ is) -- ^ Square pq ||| Square qr = Square (dimap funappend fappend . qr . pq) @@ -169,7 +178,7 @@ -- -- Vertical composition of squares. `funId` is the identity of `(===)`. infixl 5 ===-(===) :: (PAppend ps, PAppend qs, Profunctor (PList ss))+(===) :: (IsPList ps, IsPList qs, Profunctor (PList ss))       => Square ps qs fs gs -> Square rs ss gs hs -> Square (ps ++ rs) (qs ++ ss) fs hs -- ^ Square pq === Square rs = Square (\pr -> case punappend pr of P.Procompose r p -> pappend (P.Procompose (rs r) (pq p))) @@ -189,7 +198,7 @@ -- -- A functor @f@ can be bent to the right to become the profunctor @`Star` f@. toRight :: Functor f => Square '[] '[Star f] '[f] '[]-toRight = Square (P . Star . (. unF) . fmap . (Id .) . unHom)+toRight = mkSquare (Star . fmap)  -- | -- > +--f--+@@ -199,8 +208,8 @@ -- > +-----+ -- -- A functor @f@ can be bent to the left to become the profunctor @`Costar` f@.-toLeft :: Square '[Costar f] '[] '[f] '[]-toLeft = Square (Hom . dimap unF Id . runCostar . unP)+toLeft :: Functor f => Square '[Costar f] '[] '[f] '[]+toLeft = mkSquare runCostar  -- | -- > +-----+@@ -211,7 +220,7 @@ -- -- The profunctor @`Costar` f@ can be bent down to become the functor @f@ again. fromRight :: Functor f => Square '[] '[Costar f] '[] '[f]-fromRight = Square (P . Costar . (F .) . fmap . (. unId) . unHom)+fromRight = mkSquare (Costar . fmap)  -- | -- > +-----+@@ -221,8 +230,8 @@ -- > +--f--+ -- -- The profunctor @`Star` f@ can be bent down to become the functor @f@ again.-fromLeft :: Square '[Star f] '[] '[] '[f]-fromLeft = Square (Hom . dimap unId F . runStar . unP)+fromLeft :: Functor f => Square '[Star f] '[] '[] '[f]+fromLeft = mkSquare runStar  -- | -- > +-----+@@ -326,7 +335,7 @@ -- > |  v  | -- > 1--b--H ---type Square01 q a b = SquareNT Unit (PList q) (ValueF a) (ValueF b)+type Square01 qs a b = SquareNT Unit (PList qs) (ValueF a) (ValueF b)  -- | The boring profunctor from and to the unit category. data Unit a b where