squares 0.2 → 0.2.1

raw patch · 5 files changed

+108/−42 lines, 5 filesdep +kan-extensions

Dependencies added: kan-extensions

Files

• CHANGELOG.md +5/−1
• squares.cabal +4/−2
• src/Data/Functor/Kan/Square.hs +30/−38
• src/Data/Profunctor/Kan/Square.hs +69/−0
• src/Data/Square.hs +0/−1

@@ -1,6 +1,10 @@ # Revision history for squares -## 0.2 -- 2020-07-08+## 0.2.1 -- 2023-07-15++* Added `Data.Profunctor.Kan.Square`.++## 0.2 -- 2023-07-08  * Added `Data.Functor.Kan.Square`. 

@@ -1,7 +1,7 @@ cabal-version:       >=1.10  name:                squares-version:             0.2+version:             0.2.1 synopsis:            The double category of Hask functors and profunctors description:         A library for working with natural transformations of type                      .@@ -34,14 +34,16 @@                        Data.Profunctor.Square                        Data.Traversable.Square                        Data.Functor.Adjunction.Square-                       Data.Functor.Kan.Square                        Data.Functor.Rep.Square+                       Data.Functor.Kan.Square+                       Data.Profunctor.Kan.Square   build-depends:       base >= 4.9 && < 5                      , profunctors == 5.*                      , bifunctors == 5.*                      , distributive == 0.6.*                      , adjunctions == 4.*                      , comonad == 5.*+                     , kan-extensions == 5.*   hs-source-dirs:      src   default-language:    Haskell2010 

@@ -12,59 +12,51 @@ import Data.Profunctor import Data.Profunctor.Composition import Data.Functor.Compose.List---- | The left Kan extension of a functor @f@ along a profunctor @j@.------ The left Kan extension of a functor @f@ along a functor @g@ is @'Lan' ('Data.Profunctor.Costar' g) f@.-data Lan j f b = forall a. Lan (j a b) (f a)+import Data.Functor.Kan.Lan+import Data.Functor.Kan.Ran  -- | -- > +--f--+ -- > |  v  |--- > j--@  |--- > |  v  |--- > +--L--+-lanSquare :: Square '[j] '[] '[f] '[Lan j f]-lanSquare = mkSquare Lan+-- > |  @  |+-- > | / \ |+-- > | v v |+-- > +-j-L-++lanSquare :: Functor f => Square '[] '[] '[f] '[j, Lan j f]+lanSquare = mkSquare $ \k -> glan . fmap k  -- |--- > +--f--+--- > |  v  |     +--L--+--- > j-\|  |     |  v  |--- > |  @  | ==> h--@  |--- > h-/|  |     |  v  |--- > |  v  |     +--g--+--- > +--g--++-- > +--f--+     +--L--++-- > |  v  |     |  v  |+-- > |  @  | ==> |  @  |+-- > | / \ |     |  |  |+-- > | v v |     |  v  |+-- > +-j-g-+     +--g--+ -- -- Any square like the one on the left factors through 'lanSquare'. -- 'lanFactor' gives the remaining square.-lanFactor :: (Profunctor h, IsFList gs) => Square '[j, h] '[] '[f] gs -> Square '[h] '[] '[Lan j f] gs-lanFactor sq = mkSquare $ \h (Lan j f) -> runSquare sq (Procompose h j) f---- | The right Kan extension of a functor @f@ along a profunctor @j@.------ The right Kan extension of a functor @f@ along a functor @g@ is @'Ran' ('Data.Profunctor.Star' g) f@.-newtype Ran j f a = Ran { runRan :: forall b. j a b -> f b }+lanFactor :: Functor g => Square '[] '[] '[f] '[j, g] -> Square '[] '[] '[Lan j f] '[g]+lanFactor sq = mkSquare $ \k -> fmap k . toLan (runSquare sq id)  -- |--- > +--R--+--- > |  v  |--- > j--@  |+-- > +-j-R-++-- > | v v |+-- > | \ / |+-- > |  @  | -- > |  v  | -- > +--g--+-ranSquare :: Square '[j] '[] '[Ran j g] '[g]-ranSquare = mkSquare $ flip runRan+ranSquare :: Functor g => Square '[] '[] '[j, Ran j g] '[g]+ranSquare = mkSquare $ \k -> fmap k . gran  -- |--- > +--f--+--- > |  v  |     +--f--+--- > h-\|  |     |  v  |--- > |  @  | ==> h--@  |--- > j-/|  |     |  v  |--- > |  v  |     +--R--+--- > +--g--++-- > +-j-f-+     +--f--++-- > | v v |     |  v  |+-- > | \ / | ==> |  @  |+-- > |  @  |     |  |  |+-- > |  v  |     |  v  |+-- > +--g--+     +--R--+ -- -- Any square like the one on the left factors through 'ranSquare'. -- 'ranFactor' gives the remaining square.-ranFactor :: (Profunctor j, IsFList fs) => Square '[h, j] '[] fs '[g] -> Square '[h] '[] fs '[Ran j g]-ranFactor sq = mkSquare $ \h f -> Ran $ \j -> runSquare sq (Procompose j h) f+ranFactor :: Functor f => Square '[] '[] '[j, f] '[g] -> Square '[] '[] '[f] '[Ran j g]+ranFactor sq = mkSquare $ \k -> fmap k . toRan (runSquare sq id)

@@ -0,0 +1,69 @@+{-# LANGUAGE DataKinds, RankNTypes, GADTs #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Profunctor.Kan.Square+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  sjoerd@w3future.com+--+-----------------------------------------------------------------------------+module Data.Profunctor.Kan.Square where++import Data.Square+import Data.Profunctor+import Data.Profunctor.Composition+import Data.Functor.Compose.List++-- | The right Kan extension of a profunctor @p@ along a profunctor @j@.+newtype Ran j p a b = Ran { runRan :: forall c. j c a -> p c b }+instance Profunctor p => Functor (Ran j p a) where+  fmap f (Ran jp) = Ran $ rmap f . jp+instance (Profunctor j, Profunctor p) => Profunctor (Ran j p) where+  lmap l (Ran jp) = Ran $ jp . rmap l+  rmap r (Ran jp) = Ran $ rmap r . jp+  dimap l r (Ran jp) = Ran $ rmap r . jp . rmap l++-- |+-- > +-----++-- > j-\   |+-- > |  @--p+-- > R-/   |+-- > +-----++ranSquare :: (Profunctor j, Profunctor p) => Square '[j, Ran j p] '[p] '[] '[]+ranSquare = mkSquare $ \(Procompose r j) -> runRan r j++-- |+-- > +-----+     +-----++-- > j-\   |     |     |+-- > |  @--p ==> q--@--R+-- > q-/   |     |     |+-- > +-----+     +-----++--+-- Any square like the one on the left factors through 'ranSquare'.+-- 'ranFactor' gives the remaining square.+ranFactor+  :: (Profunctor j, Profunctor p, Profunctor q)+  => Square '[j, q] '[p] '[] '[] -> Square '[q] '[Ran j p] '[] '[]+ranFactor sq = mkSquare $ \q -> Ran $ \j -> runSquare sq (Procompose q j)++-- |+-- > +-----++-- > R-\   |+-- > |  @--p+-- > j-/   |+-- > +-----++riftSquare :: (Profunctor j, Profunctor p) => Square '[Rift j p, j] '[p] '[] '[]+riftSquare = mkSquare $ \(Procompose j r) -> runRift r j++-- |+-- > +-----+     +-----++-- > q-\   |     |     |+-- > |  @--p ==> q--@--R+-- > j-/   |     |     |+-- > +-----+     +-----++--+-- Any square like the one on the left factors through 'riftSquare'.+-- 'riftFactor' gives the remaining square.+riftFactor+  :: (Profunctor j, Profunctor p, Profunctor q)+  => Square '[q, j] '[p] '[] '[] -> Square '[q] '[Rift j p] '[] '[]+riftFactor sq = mkSquare $ \q -> Rift $ \j -> runSquare sq (Procompose j q)

@@ -15,7 +15,6 @@ -- Maintainer  :  sjoerd@w3future.com -- ------------------------------------------------------------------------------ module Data.Square where  import Data.Functor.Compose.List