squares 0.1 → 0.1.1
raw patch · 11 files changed
+163/−18 lines, 11 filesdep +bifunctors
Dependencies added: bifunctors
Files
- CHANGELOG.md +8/−1
- squares.cabal +5/−2
- src/Control/Monad/Square.hs +1/−1
- src/Data/Foldable/Square.hs +22/−2
- src/Data/Functor/Compose/List.hs +0/−1
- src/Data/Functor/Square.hs +45/−0
- src/Data/Profunctor/Composition/List.hs +5/−5
- src/Data/Profunctor/Square.hs +25/−0
- src/Data/Square.hs +40/−4
- src/Data/Traversable/Square.hs +12/−1
- src/Data/Type/List.hs +0/−1
CHANGELOG.md view
@@ -1,6 +1,13 @@ # Revision history for squares -## 0.1+## 0.1.1 -- 2020-05-27++* Added `fromRight2`, `fromLeft2`, `toRight2` and `toLeft2` to `Data.Square`.+* Added `any`, `all` and `afoldMap` to `Data.Foldable.Square`.+* Added `mapAccumL` and `mapAccumR` to `Data.Traversable.Square`.+* Added `fromBiff` and `toBiff` to `Data.Profunctor.Square`.++## 0.1 -- 2020-05-26 * `mkSquare` works for all functions of the right shape * Added `runSquare`, the inverse of `mkSquare`.
squares.cabal view
@@ -1,11 +1,13 @@ cabal-version: >=1.10 name: squares-version: 0.1+version: 0.1.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)@+ .+ See the "Data.Square" module for an introduction. homepage: https://github.com/sjoerdvisscher/squares bug-reports: https://github.com/sjoerdvisscher/squares/issues license: BSD3@@ -33,8 +35,9 @@ Data.Traversable.Square Data.Functor.Adjunction.Square Data.Functor.Rep.Square- build-depends: base >= 4.8 && < 5+ build-depends: base >= 4.9 && < 5 , profunctors == 5.*+ , bifunctors == 5.* , distributive == 0.6.* , adjunctions == 4.* , comonad == 5.*
src/Control/Monad/Square.hs view
@@ -59,7 +59,7 @@ -- > | v | | v | -- > +--m--+ +---m-+ bind :: Monad m => Square '[Star m] '[] '[m] '[m]-bind = mkSquare (flip (>>=) . runStar)+bind = mkSquare ((=<<) . runStar) -- | -- > +-m-m-+
src/Data/Foldable/Square.hs view
@@ -12,9 +12,10 @@ import Data.Profunctor import Data.Functor.Compose.List import qualified Data.Foldable as F+import Control.Applicative -- |--- > +--f--++-- > +--t--+ -- > | v | -- > !m-@-!m -- > | ? |@@ -22,5 +23,24 @@ -- -- `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 :: (Foldable t, Monoid m, IsFList gs) => Square '[Forget m] '[Forget m] '[t] gs foldMap = mkSquare (Forget . F.foldMap . runForget)++-- | `Data.Foldable.Square.any` is `Data.Foldable.Square.foldMap` specialized to `Data.Monoid.Any`.+any :: (Foldable t, IsFList gs) => Square '[Forget Bool] '[Forget Bool] '[t] gs+any = mkSquare (Forget . F.any . runForget)++-- | `Data.Foldable.Square.all` is `Data.Foldable.Square.foldMap` specialized to `Data.Monoid.All`.+all :: (Foldable t, IsFList gs) => Square '[Forget Bool] '[Forget Bool] '[t] gs+all = mkSquare (Forget . F.all . runForget)++-- |+-- > +--t--++-- > | v |+-- > f>-@->f+-- > | |+-- > +-----++--+-- `afoldMap` is a mapping version of `F.asum`, or a generalization of `F.concatMap`.+afoldMap :: (Foldable t, Alternative f) => Square '[Star f] '[Star f] '[t] '[]+afoldMap = mkSquare (Star . (\f -> foldr ((<|>) . f) empty) . runStar)
src/Data/Functor/Compose/List.hs view
@@ -3,7 +3,6 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-}-{-# LANGUAGE KindSignatures #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} -----------------------------------------------------------------------------
src/Data/Functor/Square.hs view
@@ -11,6 +11,7 @@ import Data.Square import Data.Functor.Identity import Data.Functor.Compose+import Data.Profunctor -- * Squares for @Identity@ @@ -44,6 +45,28 @@ fromCompose = mkSquare ((. getCompose) . fmap . fmap) -- |+-- > +-----++-- > f /->f+-- > .>-@ |+-- > g \->g+-- > +-----++--+-- > fromComposeStar = fromLeft === fromCompose === toRight2+fromComposeStar :: (Functor f, Functor g) => Square '[Star (Compose f g)] '[Star f, Star g] '[] '[]+fromComposeStar = fromLeft === fromCompose === toRight2++-- |+-- > +-----++-- > f<-\ g+-- > | @-<.+-- > g<-/ f+-- > +-----++--+-- > fromComposeCostar = fromRight === fromCompose === toLeft2+fromComposeCostar :: (Functor f, Functor g) => Square '[Costar f, Costar g] '[Costar (Compose g f)] '[] '[]+fromComposeCostar = fromRight === fromCompose === toLeft2++-- | -- > +-f-g-+ -- > | v v | -- > | \@/ |@@ -51,3 +74,25 @@ -- > +-g.f-+ toCompose :: (Functor f, Functor g) => Square '[] '[] '[f, g] '[Compose g f] toCompose = mkSquare ((Compose .) . fmap . fmap)++-- |+-- > +-----++-- > f>-\ f+-- > | @->.+-- > g>-/ g+-- > +-----++--+-- > toComposeStar = fromLeft2 === toCompose === toRight+toComposeStar :: (Functor f, Functor g) => Square '[Star f, Star g] '[Star (Compose f g)] '[] '[]+toComposeStar = fromLeft2 === toCompose === toRight++-- |+-- > +-----++-- > g /-<f+-- > .<-@ |+-- > f \-<g+-- > +-----++--+-- > toComposeCostar = fromRight2 === toCompose === toLeft+toComposeCostar :: (Functor f, Functor g) => Square '[Costar (Compose g f)] '[Costar f, Costar g] '[] '[]+toComposeCostar = fromRight2 === toCompose === toLeft
src/Data/Profunctor/Composition/List.hs view
@@ -2,9 +2,9 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-}-{-# LANGUAGE KindSignatures #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ConstrainedClassMethods #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Profunctor.Composition.List@@ -40,7 +40,7 @@ -- | 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)+ pappend :: (Profunctor (PList ps), 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.@@ -52,15 +52,15 @@ punappend q = Procompose q (Hom id) toPlainP (Hom f) = f fromPlainP f = Hom f-instance Profunctor p => IsPList '[p] where- pappend (Procompose (Hom f) (P p)) = P (rmap f p)+instance IsPList '[p] where+ pappend (Procompose (Hom f) 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) toPlainP (P p) = p fromPlainP p = P p-instance IsPList (q ': qs) => IsPList (p ': q ': qs) where+instance (Profunctor (PList (q ': qs)), 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
src/Data/Profunctor/Square.hs view
@@ -11,6 +11,7 @@ import Data.Square import qualified Data.Profunctor as P import Data.Profunctor.Composition+import Data.Bifunctor.Biff -- * Squares for profunctor subclasses @@ -89,3 +90,27 @@ -- > +-----+ toProcompose :: (P.Profunctor p, P.Profunctor q) => Square '[p, q] '[Procompose q p] '[] '[] toProcompose = mkSquare id++-- * Squares for `Biff`++-- |+-- > +--f--+ +--f--++-- > | v | |+-- > B--@--q Biff q f g is the "universal filler for the niche": q+-- > | v | |+-- > +--g--+ +--g--++fromBiff :: P.Profunctor q => Square '[Biff q f g] '[q] '[f] '[g]+fromBiff = mkSquare runBiff++-- |+-- > +-h-f-++-- > | v v | +--h--++-- > | \ / | | v |+-- > p--@--q -> p--@--B+-- > | / \ | | v |+-- > | v v | +--k--++-- > +-k-g-++--+-- This is the universal property of `Biff`.+toBiff :: (P.Profunctor q, Functor f, Functor g) => Square '[p] '[q] '[h, f] '[k, g] -> Square '[p] '[Biff q f g] '[h] '[k]+toBiff sq = mkSquare (Biff . runSquare sq)
src/Data/Square.hs view
@@ -106,7 +106,7 @@ -- -- Natural transformations between profunctors. proNat :: (Profunctor p, Profunctor q) => (p :-> q) -> Square '[p] '[q] '[] '[]-proNat n = mkSquare n+proNat = mkSquare -- | -- > +--f--+@@ -178,7 +178,7 @@ -- -- Vertical composition of squares. `funId` is the identity of `(===)`. infixl 5 ===-(===) :: (IsPList ps, IsPList qs, Profunctor (PList ss))+(===) :: (IsPList ps, IsPList qs, Profunctor (PList 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))) @@ -208,7 +208,7 @@ -- > +-----+ -- -- A functor @f@ can be bent to the left to become the profunctor @`Costar` f@.-toLeft :: Functor f => Square '[Costar f] '[] '[f] '[]+toLeft :: Square '[Costar f] '[] '[f] '[] toLeft = mkSquare runCostar -- |@@ -230,7 +230,7 @@ -- > +--f--+ -- -- The profunctor @`Star` f@ can be bent down to become the functor @f@ again.-fromLeft :: Functor f => Square '[Star f] '[] '[] '[f]+fromLeft :: Square '[Star f] '[] '[] '[f] fromLeft = mkSquare runStar -- |@@ -260,6 +260,42 @@ fromRight === toRight++-- |+-- > +-f-g-++-- > | v \>g funId ||| toRight+-- > | | | ===+-- > | \-->f toRight+-- > +-----++toRight2 :: (Functor f, Functor g) => Square '[] '[Star g, Star f] '[f, g] '[]+toRight2 = (funId ||| toRight) === toRight++-- |+-- > +-f-g-++-- > f</ v | toLeft ||| funId+-- > | | | ===+-- > g<--/ | toLeft+-- > +-----++toLeft2 :: (Functor f, Functor g) => Square '[Costar f, Costar g] '[] '[f, g] '[]+toLeft2 = (toLeft ||| funId) === toLeft++-- |+-- > +-----++-- > | /--<f fromRight+-- > | | | ===+-- > | v /<g funId ||| fromRight+-- > +-f-g-++fromRight2 :: (Functor f, Functor g) => Square '[] '[Costar f, Costar g] '[] '[f, g]+fromRight2 = fromRight === (funId ||| fromRight)++-- |+-- > +-----++-- > g>--\ | fromLeft+-- > | | | ===+-- > f>\ | | fromLeft ||| funId+-- > +-f-g-++fromLeft2 :: (Functor f, Functor g) => Square '[Star g, Star f] '[] '[] '[f, g]+fromLeft2 = fromLeft === (fromLeft ||| funId) -- | -- > +f-f-f+ +--f--+ spiderLemma n =
src/Data/Traversable/Square.hs view
@@ -8,8 +8,9 @@ ----------------------------------------------------------------------------- module Data.Traversable.Square where -import Prelude hiding (traverse)+import Prelude hiding (traverse, sequence) import Data.Square+import Data.Bifunctor.Biff import Data.Profunctor import qualified Data.Traversable as T @@ -47,6 +48,8 @@ -- > g>-T->g g>/|\>g -- > | v | | v | -- > +--t--+ +--t--++--+-- > traverse = (fromLeft ||| funId) === sequence === (funId ||| toRight) traverse :: (Traversable t, Applicative f) => Square '[Star f] '[Star f] '[t] '[t] traverse = mkSquare (Star . T.traverse . runStar) @@ -60,3 +63,11 @@ -- @sequence = toRight ||| traverse ||| fromLeft@ sequence :: (Traversable t, Applicative f) => Square '[] '[] '[f, t] '[t, f] sequence = toRight ||| traverse ||| fromLeft++-- | > mapAccumL :: ((s, a) -> (s, b)) -> (s, t a) -> (s, t b)+mapAccumL :: Traversable t => Square '[Biff (->) ((,) s) ((,) s)] '[Biff (->) ((,) s) ((,) s)] '[t] '[t]+mapAccumL = mkSquare (Biff . uncurry . T.mapAccumL . curry . runBiff)++-- | > mapAccumR :: ((s, a) -> (s, b)) -> (s, t a) -> (s, t b)+mapAccumR :: Traversable t => Square '[Biff (->) ((,) s) ((,) s)] '[Biff (->) ((,) s) ((,) s)] '[t] '[t]+mapAccumR = mkSquare (Biff . uncurry . T.mapAccumR . curry . runBiff)
src/Data/Type/List.hs view
@@ -2,7 +2,6 @@ {-# LANGUAGE PolyKinds #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-}-{-# LANGUAGE KindSignatures #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Type.List