kan-extensions 4.0.3 → 4.1

raw patch · 7 files changed

+405/−44 lines, 7 filesdep −speculationdep ~adjunctionsdep ~basedep ~contravariantPVP ok

version bump matches the API change (PVP)

Dependencies removed: speculation

Dependency ranges changed: adjunctions, base, contravariant, mtl, transformers

API changes (from Hackage documentation)

Files

• CHANGELOG.markdown +4/−0
• kan-extensions.cabal +7/−6
• src/Control/Monad/Co.hs +0/−11
• src/Control/Monad/Codensity.hs +0/−14
• src/Data/Functor/Contravariant/Day.hs +212/−0
• src/Data/Functor/Day.hs +182/−0
• src/Data/Functor/Yoneda.hs +0/−13

@@ -1,3 +1,7 @@+4.1+---+* Moved co- and contra- variant `Day` convolution from `contravariant` to here. Day convolution is intimately connected to `Rift`.+ 4.0.3 ----- * Added `liftCoT0M`, `liftCoT1M`, `diter` and `dctrlM` for using `CoT w m` to model a state machine with states in `w` and effects in `m`.

@@ -1,6 +1,6 @@ name:          kan-extensions category:      Data Structures, Monads, Comonads, Functors-version:       4.0.3+version:       4.1 license:       BSD3 cabal-version: >= 1.6 license-file:  LICENSE@@ -40,26 +40,27 @@     TypeFamilies    build-depends:-    adjunctions   >= 4       && < 5,+    adjunctions   >= 4.2     && < 5,     array         >= 0.3.0.2 && < 0.6,     base          >= 4       && < 5,     comonad       >= 4       && < 5,     containers    >= 0.4     && < 0.6,-    contravariant >= 0.4.4   && < 1,+    contravariant >= 1       && < 2,     distributive  >= 0.2.2   && < 1,     free          >= 4       && < 5,-    mtl           >= 2.0.1   && < 2.2,+    mtl           >= 2.0.1   && < 2.3,     pointed       >= 4       && < 5,     semigroupoids >= 4       && < 5,-    speculation   >= 1.5.0.1 && < 2,-    transformers  >= 0.2     && < 0.4+    transformers  >= 0.2     && < 0.5    exposed-modules:     Control.Comonad.Density     Control.Monad.Co     Control.Monad.Codensity+    Data.Functor.Contravariant.Day     Data.Functor.Contravariant.Yoneda     Data.Functor.Contravariant.Coyoneda+    Data.Functor.Day     Data.Functor.Kan.Lan     Data.Functor.Kan.Lift     Data.Functor.Kan.Ran

@@ -7,9 +7,6 @@ #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif-#ifndef MIN_VERSION_speculation-#define MIN_VERSION_speculation(x,y,z) 1-#endif ----------------------------------------------------------------------------- -- | -- Copyright   :  (C) 2011 Edward Kmett@@ -64,8 +61,6 @@ import Control.Comonad.Env.Class as Env import Control.Comonad.Store.Class import Control.Comonad.Traced.Class as Traced-import Control.Concurrent.Speculation-import Control.Concurrent.Speculation.Class import Control.Monad.Error.Class import Control.Monad.IO.Class import Control.Monad.Identity@@ -75,12 +70,6 @@ import Control.Monad.Writer.Class as Writer import Data.Functor.Bind import Data.Functor.Extend--instance Comonad w => MonadSpec (CoT w m) where-  specByM f g a = CoT (\k -> specBy f g (extract k) a)-#if !(MIN_VERSION_speculation(1,5,0))-  specByM' f g a = CoT (\k -> specBy' f g (extract k) a)-#endif  type Co w = CoT w Identity 

@@ -6,10 +6,6 @@ #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif--#ifndef MIN_VERSION_speculation-#define MIN_VERSION_speculation(x,y,z) 1-#endif ----------------------------------------------------------------------------- -- | -- Module      :  Control.Monad.Codensity@@ -31,8 +27,6 @@   ) where  import Control.Applicative-import Control.Concurrent.Speculation-import Control.Concurrent.Speculation.Class import Control.Monad (ap, MonadPlus(..)) import Control.Monad.Free import Control.Monad.IO.Class@@ -59,14 +53,6 @@ newtype Codensity m a = Codensity   { runCodensity :: forall b. (a -> m b) -> m b   }--instance MonadSpec (Codensity m) where-  specByM f g a = Codensity $ \k -> specBy f g k a-  {-# INLINE specByM #-}-#if !(MIN_VERSION_speculation(1,5,0))-  specByM' f g a = Codensity $ \k -> specBy' f g k a-  {-# INLINE specByM' #-}-#endif  instance Functor (Codensity k) where   fmap f (Codensity m) = Codensity (\k -> m (k . f))

@@ -0,0 +1,212 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE Rank2Types #-}+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 707+{-# LANGUAGE DeriveDataTypeable #-}+#endif+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ <= 707+{-# LANGUAGE KindSignatures #-}+#endif+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE Trustworthy #-}+#endif+-----------------------------------------------------------------------------+-- |+-- Copyright   :  (C) 2013-2014 Edward Kmett, Gershom Bazerman and Derek Elkins+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+-- The Day convolution of two contravariant functors is a contravariant+-- functor.+--+-- <http://ncatlab.org/nlab/show/Day+convolution>+----------------------------------------------------------------------------++module Data.Functor.Contravariant.Day+  ( Day(..)+  , day+  , runDay+  , assoc, disassoc+  , swapped+  , intro1, intro2+  , day1, day2+  , diag+  , trans1, trans2+  ) where++import Control.Applicative+import Data.Functor.Contravariant+import Data.Functor.Contravariant.Rep+import Data.Proxy+import Data.Tuple (swap)+#ifdef __GLASGOW_HASKELL__+import Data.Typeable+#endif++-- | The Day convolution of two contravariant functors.+data Day f g a = forall b c. Day (f b) (g c) (a -> (b, c))+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 707+  deriving Typeable+#endif++-- | Construct the Day convolution+--+-- @+-- 'day1' ('day' f g) = f+-- 'day2' ('day' f g) = g+-- @+day :: f a -> g b -> Day f g (a, b)+day fa gb = Day fa gb id++#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 707+instance (Typeable1 f, Typeable1 g) => Typeable1 (Day f g) where+    typeOf1 tfga = mkTyConApp dayTyCon [typeOf1 (fa tfga), typeOf1 (ga tfga)]+        where fa :: t f (g :: * -> *) a -> f a+              fa = undefined+              ga :: t (f :: * -> *) g a -> g a+              ga = undefined++dayTyCon :: TyCon+#if MIN_VERSION_base(4,4,0)+dayTyCon = mkTyCon3 "contravariant" "Data.Functor.Contravariant.Day" "Day"+#else+dayTyCon = mkTyCon "Data.Functor.Contravariant.Day.Day"+#endif++#endif++instance Contravariant (Day f g) where+  contramap f (Day fb gc abc) = Day fb gc (abc . f)++instance (Representable f, Representable g) => Representable (Day f g) where+  type Rep (Day f g) = (Rep f, Rep g)++  tabulate a2fg = Day (tabulate fst) (tabulate snd) $ \a -> let b = a2fg a in (b,b)++  index (Day fb gc abc) a = case abc a of+    (b, c) -> (index fb b, index gc c)+  {-# INLINE index #-}++  contramapWithRep d2eafg (Day fb gc abc) = Day (contramapWithRep id fb) (contramapWithRep id gc) $ \d -> case d2eafg d of+    Left a -> case abc a of+      (b, c) -> (Left b, Left c)+    Right (vf, vg) -> (Right vf, Right vg)+  {-# INLINE tabulate #-}+++-- | Break apart the Day convolution of two contravariant functors.+runDay :: (Contravariant f, Contravariant g) => Day f g a -> (f a, g a)+runDay (Day fb gc abc) =+  ( contramap (fst . abc) fb+  , contramap (snd . abc) gc+  )++-- | Day convolution provides a monoidal product. The associativity+-- of this monoid is witnessed by 'assoc' and 'disassoc'.+--+-- @+-- 'assoc' . 'disassoc' = 'id'+-- 'disassoc' . 'assoc' = 'id'+-- 'contramap' f '.' 'assoc' = 'assoc' '.' 'contramap' f+-- @+assoc :: Day f (Day g h) a -> Day (Day f g) h a+assoc (Day fb (Day gd he cde) abc) = Day (Day fb gd id) he $ \a ->+  case cde <$> abc a of+    (b, (d, e)) -> ((b, d), e)++-- | Day convolution provides a monoidal product. The associativity+-- of this monoid is witnessed by 'assoc' and 'disassoc'.+--+-- @+-- 'assoc' . 'disassoc' = 'id'+-- 'disassoc' . 'assoc' = 'id'+-- 'contramap' f '.' 'disassoc' = 'disassoc' '.' 'contramap' f+-- @+disassoc :: Day (Day f g) h a -> Day f (Day g h) a+disassoc (Day (Day fd ge bde) hc abc) = Day fd (Day ge hc id) $ \a ->+  case abc a of+    (b, c) -> case bde b of+      (d, e) -> (d, (e, c))++-- | The monoid for Day convolution /in Haskell/ is symmetric.+--+-- @+-- 'contramap' f '.' 'swapped' = 'swapped' '.' 'contramap' f+-- @+swapped :: Day f g a -> Day g f a+swapped (Day fb gc abc) = Day gc fb (swap . abc)++-- | Proxy serves as the unit of Day convolution.+--+-- @+-- 'day1' '.' 'intro1' = 'id'+-- 'contramap' f '.' 'intro1' = 'intro1' '.' 'contramap' f+-- @+intro1 :: f a -> Day Proxy f a+intro1 fa = Day Proxy fa $ \a -> ((),a)++-- | Proxy serves as the unit of Day convolution.+--+-- @+-- 'day2' '.' 'intro2' = 'id'+-- 'contramap' f '.' 'intro2' = 'intro2' '.' 'contramap' f+-- @+intro2 :: f a -> Day f Proxy a+intro2 fa = Day fa Proxy $ \a -> (a,())++-- | In Haskell we can do general purpose elimination, but in a more general setting+-- it is only possible to eliminate the unit.+--+-- @+-- 'day1' '.' 'intro1' = 'id'+-- 'day1' = 'fst' '.' 'runDay'+-- 'contramap' f '.' 'day1' = 'day1' '.' 'contramap' f+-- @+day1 :: Contravariant f => Day f g a -> f a+day1 (Day fb _ abc) = contramap (fst . abc) fb++-- | In Haskell we can do general purpose elimination, but in a more general setting+-- it is only possible to eliminate the unit.+-- @+-- 'day2' '.' 'intro2' = 'id'+-- 'day2' = 'snd' '.' 'runDay'+-- 'contramap' f '.' 'day2' = 'day2' '.' 'contramap' f+-- @+day2 :: Contravariant g => Day f g a -> g a+day2 (Day _ gc abc) = contramap (snd . abc) gc++-- | Diagonalize the Day convolution:+--+-- @+-- 'day1' '.' 'diag' = 'id'+-- 'day2' '.' 'diag' = 'id'+-- 'runDay' '.' 'diag' = \a -> (a,a)+-- 'contramap' f . 'diag' = 'diag' . 'contramap' f+-- @++diag :: f a -> Day f f a+diag fa = Day fa fa $ \a -> (a,a)++-- | Apply a natural transformation to the left-hand side of a Day convolution.+--+-- This respects the naturality of the natural transformation you supplied:+--+-- @+-- 'contramap' f '.' 'trans1' fg = 'trans1' fg '.' 'contramap' f+-- @+trans1 :: (forall x. f x -> g x) -> Day f h a -> Day g h a+trans1 fg (Day fb hc abc) = Day (fg fb) hc abc++-- | Apply a natural transformation to the right-hand side of a Day convolution.+--+-- This respects the naturality of the natural transformation you supplied:+--+-- @+-- 'contramap' f '.' 'trans2' fg = 'trans2' fg '.' 'contramap' f+-- @+trans2 :: (forall x. g x -> h x) -> Day f g a -> Day f h a+trans2 gh (Day fb gc abc) = Day fb (gh gc) abc

@@ -0,0 +1,182 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE RankNTypes #-}+-----------------------------------------------------------------------------+-- |+-- Copyright   :  (C) 2014 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+-- Eitan Chatav first introduced me to this construction+--+-- The Day convolution of two covariant functors is a covariant functor.+--+-- Day convolution is usually defined in terms of contravariant functors,+-- however, it just needs a monoidal category, and Hask^op is also monoidal.+--+-- Day convolution can be used to nicely describe monoidal functors as monoid+-- objects w.r.t this product.+--+-- <http://ncatlab.org/nlab/show/Day+convolution>+----------------------------------------------------------------------------++module Data.Functor.Day+  ( Day(..)+  , day+  , dap+  , assoc, disassoc+  , swapped+  , intro1, intro2+  , elim1, elim2+  , trans1, trans2+  ) where++import Control.Applicative+import Data.Distributive+import Data.Functor.Identity+import Data.Functor.Rep+#ifdef __GLASGOW_HASKELL__+import Data.Typeable+#endif++-- | The Day convolution of two covariant functors.+--+-- @Day f g a -> h a@ is isomorphic to @f a -> Rift g h a@+data Day f g a = forall b c. Day (f b) (g c) (b -> c -> a)+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 707+  deriving Typeable+#endif++-- | Construct the Day convolution+day :: f (a -> b) -> g a -> Day f g b+day fa gb = Day fa gb id++#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 707+instance (Typeable1 f, Typeable1 g) => Typeable1 (Day f g) where+    typeOf1 tfga = mkTyConApp dayTyCon [typeOf1 (fa tfga), typeOf1 (ga tfga)]+        where fa :: t f (g :: * -> *) a -> f a+              fa = undefined+              ga :: t (f :: * -> *) g a -> g a+              ga = undefined++dayTyCon :: TyCon+#if MIN_VERSION_base(4,4,0)+dayTyCon = mkTyCon3 "contravariant" "Data.Functor.Day" "Day"+#else+dayTyCon = mkTyCon "Data.Functor.Day.Day"+#endif++#endif++instance Functor (Day f g) where+  fmap f (Day fb gc bca) = Day fb gc $ \b c -> f (bca b c)++instance (Representable f, Representable g) => Distributive (Day f g) where+  distribute f = Day (tabulate id) (tabulate id) $ \x y -> fmap (\(Day m n o) -> o (index m x) (index n y)) f++instance (Representable f, Representable g) => Representable (Day f g) where+  type Rep (Day f g) = (Rep f, Rep g)+  tabulate f = Day (tabulate id) (tabulate id) (curry f)+  index (Day m n o) (x,y) = o (index m x) (index n y)++-- | Day convolution provides a monoidal product. The associativity+-- of this monoid is witnessed by 'assoc' and 'disassoc'.+--+-- @+-- 'assoc' . 'disassoc' = 'id'+-- 'disassoc' . 'assoc' = 'id'+-- 'fmap' f '.' 'assoc' = 'assoc' '.' 'fmap' f+-- @+assoc :: Day f (Day g h) a -> Day (Day f g) h a+assoc (Day fb (Day gd he dec) bca) = Day (Day fb gd (,)) he $+  \ (b,d) e -> bca b (dec d e)++-- | Day convolution provides a monoidal product. The associativity+-- of this monoid is witnessed by 'assoc' and 'disassoc'.+--+-- @+-- 'assoc' . 'disassoc' = 'id'+-- 'disassoc' . 'assoc' = 'id'+-- 'fmap' f '.' 'disassoc' = 'disassoc' '.' 'fmap' f+-- @+disassoc :: Day (Day f g) h a -> Day f (Day g h) a+disassoc (Day (Day fb gc bce) hd eda) = Day fb (Day gc hd (,)) $ \ b (c,d) ->+  eda (bce b c) d++-- | The monoid for 'Day' convolution on the cartesian monoidal structure is symmetric.+--+-- @+-- 'fmap' f '.' 'swapped' = 'swapped' '.' 'fmap' f+-- @+swapped :: Day f g a -> Day g f a+swapped (Day fb gc abc) = Day gc fb (flip abc)++-- | 'Identity' is the unit of 'Day' convolution+--+-- @+-- 'intro1' '.' 'elim1' = 'id'+-- 'elim1' '.' 'intro1' = 'id'+-- @+intro1 :: f a -> Day Identity f a+intro1 fa = Day (Identity ()) fa $ \_ a -> a++-- | 'Identity' is the unit of 'Day' convolution+--+-- @+-- 'intro2' '.' 'elim2' = 'id'+-- 'elim2' '.' 'intro2' = 'id'+-- @+intro2 :: f a -> Day f Identity a+intro2 fa = Day fa (Identity ()) const++-- | 'Identity' is the unit of 'Day' convolution+--+-- @+-- 'intro1' '.' 'elim1' = 'id'+-- 'elim1' '.' 'intro1' = 'id'+-- @+elim1 :: Functor f => Day Identity f a -> f a+elim1 (Day (Identity b) fc bca) = bca b <$> fc++-- | 'Identity' is the unit of 'Day' convolution+--+-- @+-- 'intro2' '.' 'elim2' = 'id'+-- 'elim2' '.' 'intro2' = 'id'+-- @+elim2 :: Functor f => Day f Identity a -> f a+elim2 (Day fb (Identity c) bca) = flip bca c <$> fb++-- | Collapse via a monoidal functor.+--+-- @ +-- 'dap' ('day' f g) = f '<*>' g+-- @+dap :: Applicative f => Day f f a -> f a+dap (Day fb fc abc) = liftA2 abc fb fc++-- | Apply a natural transformation to the left-hand side of a Day convolution.+--+-- This respects the naturality of the natural transformation you supplied:+--+-- @+-- 'fmap' f '.' 'trans1' fg = 'trans1' fg '.' 'fmap' f+-- @+trans1 :: (forall x. f x -> g x) -> Day f h a -> Day g h a+trans1 fg (Day fb hc bca) = Day (fg fb) hc bca++-- | Apply a natural transformation to the right-hand side of a Day convolution.+--+-- This respects the naturality of the natural transformation you supplied:+--+-- @+-- 'fmap' f '.' 'trans2' fg = 'trans2' fg '.' 'fmap' f+-- @+trans2 :: (forall x. g x -> h x) -> Day f g a -> Day f h a+trans2 gh (Day fb gc bca) = Day fb (gh gc) bca

@@ -9,9 +9,6 @@ {-# LANGUAGE Trustworthy #-} #endif -#ifndef MIN_VERSION_speculation-#define MIN_VERSION_speculation(x,y,z) 1-#endif ----------------------------------------------------------------------------- -- | -- Module      :  Data.Functor.Yoneda@@ -47,8 +44,6 @@ import Control.Monad.Trans.Class import Control.Comonad import Control.Comonad.Trans.Class-import Control.Concurrent.Speculation-import Control.Concurrent.Speculation.Class import Data.Distributive import Data.Foldable import Data.Function (on)@@ -65,14 +60,6 @@ import Data.Traversable import Text.Read hiding (lift) import Prelude hiding (sequence, lookup, zipWith)--instance Monad m => MonadSpec (Yoneda m) where-  specByM f g a = Yoneda $ \k -> specBy f g (return . k) a-  {-# INLINE specByM #-}-#if !(MIN_VERSION_speculation(1,5,0))-  specByM' f g a = Yoneda $ \k -> specBy' f g (return . k) a-  {-# INLINE specByM' #-}-#endif  -- | @Yoneda f a@ can be viewed as the partial application of 'fmap' to its second argument. newtype Yoneda f a = Yoneda { runYoneda :: forall b. (a -> b) -> f b }