From ee85ec12093e7ea1b3c2f5b7ba7f9271b6c370b3 Mon Sep 17 00:00:00 2001 From: Justin Le Date: Fri, 3 May 2019 23:28:03 -0700 Subject: [PATCH 1/3] extensions for kan-extension types --- src/Data/Pointed.hs | 35 +++++++++++++++++++++++++++++++++++ 1 file changed, 35 insertions(+) diff --git a/src/Data/Pointed.hs b/src/Data/Pointed.hs index 277e081..5ff1f4b 100644 --- a/src/Data/Pointed.hs +++ b/src/Data/Pointed.hs @@ -29,7 +29,14 @@ import Data.Tree (Tree(..)) #endif #ifdef MIN_VERSION_kan_extensions +import Control.Comonad.Density +import Control.Monad.Codensity +import Data.Functor.Coyoneda +import Data.Functor.Day import Data.Functor.Day.Curried +import Data.Functor.Kan.Lan +import Data.Functor.Yoneda +import qualified Data.Functor.Invariant.Day as ID #endif #if defined(MIN_VERSION_semigroups) || (MIN_VERSION_base(4,9,0)) @@ -180,6 +187,34 @@ instance Pointed Set where instance (Functor g, g ~ h) => Pointed (Curried g h) where point a = Curried (fmap ($a)) {-# INLINE point #-} + +instance (Pointed f, Pointed g) => Pointed (Day f g) where + point a = Day (point ()) (point ()) (\_ _ -> a) + {-# INLINE point #-} + +instance Pointed f => Pointed (Coyoneda f) where + point a = Coyoneda (const a) (point ()) + {-# INLINE point #-} + +instance (Pointed f, Functor f) => Pointed (Yoneda f) where + point a = Yoneda $ \f -> f a <$ point () + {-# INLINE point #-} + +instance Pointed f => Pointed (Density f) where + point a = Density (const a) (point ()) + {-# INLINE point #-} + +instance Pointed (Codensity f) where + point = pure + {-# INLINE point #-} + +instance (Pointed f, Pointed g) => Pointed (ID.Day f g) where + point a = ID.Day (point ()) (point ()) (\_ _ -> a) (const ((),())) + {-# INLINE point #-} + +instance (Functor g, Pointed h) => Pointed (Lan g h) where + point a = Lan (const a) (point ()) + {-# INLINE point #-} #endif #ifdef MIN_VERSION_semigroupoids From bfcd00becdb4686c31d3b0a288e4bf0240b35fcb Mon Sep 17 00:00:00 2001 From: Justin Le Date: Sat, 4 May 2019 00:01:16 -0700 Subject: [PATCH 2/3] Copointed instances, and more Pointed instances --- src/Data/Copointed.hs | 25 +++++++++++++++++++++++++ src/Data/Pointed.hs | 18 +++++++++++++++++- 2 files changed, 42 insertions(+), 1 deletion(-) diff --git a/src/Data/Copointed.hs b/src/Data/Copointed.hs index e00c771..458265d 100644 --- a/src/Data/Copointed.hs +++ b/src/Data/Copointed.hs @@ -15,6 +15,7 @@ import Data.Default.Class import Control.Comonad.Trans.Env import Control.Comonad.Trans.Store import Control.Comonad.Trans.Traced +import Control.Comonad #if !(MIN_VERSION_comonad(4,3,0)) import Data.Functor.Coproduct @@ -29,6 +30,13 @@ import Data.Tree import Data.Functor.Bind #endif +#ifdef MIN_VERSION_kan_extensions +import Control.Comonad.Density +import Data.Functor.Coyoneda +import Data.Functor.Day +import Data.Functor.Yoneda +import qualified Data.Functor.Invariant.Day as ID +#endif #if defined(MIN_VERSION_semigroups) || (MIN_VERSION_base(4,9,0)) import Data.Semigroup as Semigroup @@ -128,6 +136,23 @@ instance (Copointed f, Copointed g) => Copointed (F.Sum f g) where copoint (F.InR m) = copoint m #endif +#ifdef MIN_VERSION_kan_extensions +instance Copointed (Density f) where + copoint = extract + +instance Copointed f => Copointed (Coyoneda f) where + copoint (Coyoneda f x) = f (copoint x) + +instance (Copointed f, Copointed g) => Copointed (Day f g) where + copoint (Day x y f) = f (copoint x) (copoint y) + +instance (Copointed f, Copointed g) => Copointed (ID.Day f g) where + copoint (ID.Day x y f _) = f (copoint x) (copoint y) + +instance Copointed f => Copointed (Yoneda f) where + copoint = copoint . ($ id) . runYoneda +#endif + #ifdef MIN_VERSION_transformers instance Copointed f => Copointed (Backwards f) where copoint = copoint . forwards diff --git a/src/Data/Pointed.hs b/src/Data/Pointed.hs index 5ff1f4b..a952083 100644 --- a/src/Data/Pointed.hs +++ b/src/Data/Pointed.hs @@ -13,6 +13,7 @@ import Control.Arrow import Control.Applicative import qualified Data.Monoid as Monoid import Data.Default.Class +import Data.Functor.Contravariant #ifdef MIN_VERSION_comonad import Control.Comonad @@ -36,6 +37,9 @@ import Data.Functor.Day import Data.Functor.Day.Curried import Data.Functor.Kan.Lan import Data.Functor.Yoneda +import qualified Data.Functor.Contravariant.Coyoneda as Contra +import qualified Data.Functor.Contravariant.Day as Contra +import qualified Data.Functor.Contravariant.Yoneda as Contra import qualified Data.Functor.Invariant.Day as ID #endif @@ -192,12 +196,24 @@ instance (Pointed f, Pointed g) => Pointed (Day f g) where point a = Day (point ()) (point ()) (\_ _ -> a) {-# INLINE point #-} +instance (Pointed f, Pointed g) => Pointed (Contra.Day f g) where + point a = Contra.Day (point a) (point a) (\x -> (x, x)) + {-# INLINE point #-} + instance Pointed f => Pointed (Coyoneda f) where point a = Coyoneda (const a) (point ()) {-# INLINE point #-} +instance Pointed f => Pointed (Contra.Coyoneda f) where + point a = Contra.Coyoneda id (point a) + {-# INLINE point #-} + instance (Pointed f, Functor f) => Pointed (Yoneda f) where - point a = Yoneda $ \f -> f a <$ point () + point a = Yoneda $ \f -> f <$> point a + {-# INLINE point #-} + +instance (Pointed f, Contravariant f) => Pointed (Contra.Yoneda f) where + point a = Contra.Yoneda $ \f -> contramap f (point a) {-# INLINE point #-} instance Pointed f => Pointed (Density f) where From 7c42e4b00f9b5d46255b6eee513e0ebfd8816bd2 Mon Sep 17 00:00:00 2001 From: Justin Le Date: Sat, 4 May 2019 00:36:24 -0700 Subject: [PATCH 3/3] add contravariant to cabal --- pointed.cabal | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/pointed.cabal b/pointed.cabal index d79c461..a60ea19 100644 --- a/pointed.cabal +++ b/pointed.cabal @@ -70,7 +70,8 @@ flag unordered-containers library build-depends: base >= 4.5 && < 5, - data-default-class >= 0.0.1 && < 0.2 + data-default-class >= 0.0.1 && < 0.2, + contravariant == 1.* if impl(ghc >= 7.0 && < 7.2) build-depends: generic-deriving >= 1.11 && < 1.13