packages feed

kan-extensions 5.2.5 → 5.2.6

raw patch · 16 files changed

+102/−315 lines, 16 filesdep −faildep −transformers-compatdep ~basedep ~containersdep ~mtl

Dependencies removed: fail, transformers-compat

Dependency ranges changed: base, containers, mtl, semigroupoids, transformers

Files

− .ghci 
@@ -1,1 +0,0 @@-:set -isrc -idist/build/autogen -optP-include -optPdist/build/autogen/cabal_macros.h
CHANGELOG.markdown view
@@ -1,3 +1,18 @@+5.2.6 [2024.05.04]+------------------+* Drop support for GHC 8.2 and earlier.+* Generalize instances in `Control.Monad.Codensity` to be of the form:++  ```hs+  instance (f ~~ f', MonadFail f') => MonadFail (Codensity (f :: k -> TYPE rep))+  ```++  This avoids having to constrain `k ~ Type` and `rep ~ LiftedRep`, which could potentially harm type inference.+* Explicitly implement `liftA2` in the `Applicative` instance for `Data.Functor.Day.Curried`.+* Add an `Adjunction` instance for `Data.Functor.Day`.+* Add `Adjunction` and `Divisible` instances for `Data.Functor.Contravariant.Day`.+* Add an `Apply` instance for `Data.Functor.Day.Curried`.+ 5.2.5 [2022.06.26] ------------------ * Only require a `Functor` constraint in the `Eq` and `Ord` instances for
− include/kan-extensions-common.h 
@@ -1,19 +0,0 @@-#ifndef MIN_VERSION_base-#define MIN_VERSION_base(x,y,z) 1-#endif--#ifndef MIN_VERSION_mtl-#define MIN_VERSION_mtl(x,y,z) 1-#endif--#if MIN_VERSION_base(4,9,0)-#define LIFTED_FUNCTOR_CLASSES 1-#else-#if MIN_VERSION_transformers(0,5,0)-#define LIFTED_FUNCTOR_CLASSES 1-#else-#if MIN_VERSION_transformers_compat(0,5,0) && !MIN_VERSION_transformers(0,4,0)-#define LIFTED_FUNCTOR_CLASSES 1-#endif-#endif-#endif
kan-extensions.cabal view
@@ -1,6 +1,6 @@ name:          kan-extensions category:      Data Structures, Monads, Comonads, Functors-version:       5.2.5+version:       5.2.6 license:       BSD3 cabal-version: >= 1.10 license-file:  LICENSE@@ -13,26 +13,20 @@ synopsis:      Kan extensions, Kan lifts, the Yoneda lemma, and (co)density (co)monads description:   Kan extensions, Kan lifts, various forms of the Yoneda lemma, and (co)density (co)monads. build-type:    Simple-tested-with:   GHC == 7.4.2-             , GHC == 7.6.3-             , GHC == 7.8.4-             , GHC == 7.10.3-             , GHC == 8.0.2-             , GHC == 8.2.2-             , GHC == 8.4.4+tested-with:   GHC == 8.4.4              , GHC == 8.6.5              , GHC == 8.8.4              , GHC == 8.10.7              , GHC == 9.0.2-             , GHC == 9.2.2+             , GHC == 9.2.8+             , GHC == 9.4.5+             , GHC == 9.6.2  extra-source-files:   .gitignore-  .ghci   .vim.custom   CHANGELOG.markdown   README.markdown-  include/kan-extensions-common.h  source-repository head   type: git@@ -40,8 +34,6 @@  library   hs-source-dirs: src-  include-dirs: include-  includes: kan-extensions-common.h    other-extensions:     CPP@@ -56,19 +48,18 @@   build-depends:     adjunctions         >= 4.2     && < 5,     array               >= 0.3.0.2 && < 0.6,-    base                >= 4.4     && < 5,+    base                >= 4.11    && < 5,     comonad             >= 4       && < 6,-    containers          >= 0.4     && < 0.7,+    containers          >= 0.4     && < 0.8,     contravariant       >= 1       && < 2,     distributive        >= 0.2.2   && < 1,     invariant           >= 0.1     && < 1,     free                >= 4       && < 6,-    mtl                 >= 2.0.1   && < 2.4,+    mtl                 >= 2.2.1   && < 2.4,     profunctors         >= 5       && < 6,-    semigroupoids       >= 4       && < 6,+    semigroupoids       >= 5.2.2   && < 7,     tagged              >= 0.7.2   && < 1,-    transformers        >= 0.2     && < 0.7,-    transformers-compat >= 0.3     && < 0.8+    transformers        >= 0.5     && < 0.7    exposed-modules:     Control.Comonad.Density@@ -85,17 +76,8 @@     Data.Functor.Yoneda     Data.Functor.Coyoneda -  ghc-options: -Wall-  default-language: Haskell2010--  if impl(ghc >= 7.10)-    ghc-options: -fno-warn-trustworthy-safe--  -- See https://ghc.haskell.org/trac/ghc/wiki/Migration/8.0#base-4.9.0.0-  if impl(ghc >= 8.0)-    ghc-options: -Wcompat -Wnoncanonical-monad-instances+  ghc-options: -Wall -Wcompat -Wnoncanonical-monad-instances -Wno-trustworthy-safe+  if !impl(ghc >= 8.8)+    ghc-options: -Wnoncanonical-monadfail-instances -    if !impl(ghc >= 8.8)-      ghc-options: -Wnoncanonical-monadfail-instances-  else-    build-depends: fail >= 4.9 && < 5+  default-language: Haskell2010
src/Control/Comonad/Density.hs view
@@ -1,12 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-}-#if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-}-#endif {-# LANGUAGE MultiParamTypeClasses #-}-#if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ < 710-{-# LANGUAGE Trustworthy #-}-#endif ----------------------------------------------------------------------------- -- | -- Module      :  Control.Comonad.Density@@ -32,7 +27,9 @@   , densityToLan, lanToDensity   ) where +#if !(MIN_VERSION_base(4,18,0)) import Control.Applicative+#endif import Control.Comonad import Control.Comonad.Trans.Class import Data.Functor.Apply
src/Control/Monad/Co.hs view
@@ -1,15 +1,9 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}-#if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-}-#endif-#if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ < 710-{-# LANGUAGE Trustworthy #-}-#endif ----------------------------------------------------------------------------- -- | -- Copyright   :  (C) 2011-2016 Edward Kmett@@ -57,9 +51,6 @@   , askW, asksW, traceW   )where -#if __GLASGOW_HASKELL__ < 710-import Control.Applicative-#endif import Control.Comonad import Control.Comonad.Cofree import Control.Comonad.Density
src/Control/Monad/Codensity.hs view
@@ -4,16 +4,11 @@ {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-}-#if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-}-#endif-#if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-}-#endif-#if (__GLASGOW_HASKELL__ >= 708) && (__GLASGOW_HASKELL__ < 802)-{-# LANGUAGE DeriveDataTypeable #-}-#endif-#if __GLASGOW_HASKELL__ >= 802+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+#if __GLASGOW_HASKELL__ < 806 {-# LANGUAGE TypeInType #-} #endif @@ -54,12 +49,8 @@ import Data.Functor.Kan.Ran import Data.Functor.Plus import Data.Functor.Rep-#if (__GLASGOW_HASKELL__ >= 708) && (__GLASGOW_HASKELL__ < 800)-import Data.Typeable-#endif-#if __GLASGOW_HASKELL__ >= 802+import Data.Type.Equality (type (~~)) import GHC.Exts (TYPE)-#endif  -- | -- @'Codensity' f@ is the Monad generated by taking the right Kan extension@@ -72,61 +63,49 @@ -- Voigtländer for more information about this type. -- -- <https://www.janis-voigtlaender.eu/papers/AsymptoticImprovementOfComputationsOverFreeMonads.pdf>-#if __GLASGOW_HASKELL__ >= 802 newtype Codensity (m :: k -> TYPE rep) a = Codensity -- Note: we *could* generalize @a@ to @TYPE repa@, but the 'Functor' -- instance wouldn't carry that, so it doesn't really seem worth -- the complication.-#else-newtype Codensity m a = Codensity-#endif   { runCodensity :: forall b. (a -> m b) -> m b   }-#if (__GLASGOW_HASKELL__ >= 708) && (__GLASGOW_HASKELL__ < 800)-    deriving Typeable-#endif -#if __GLASGOW_HASKELL__ >= 802 instance Functor (Codensity (k :: j -> TYPE rep)) where-#else-instance Functor (Codensity k) where-#endif   fmap f (Codensity m) = Codensity (\k -> m (\x -> k (f x)))   {-# INLINE fmap #-} -#if __GLASGOW_HASKELL__ >= 802 instance Apply (Codensity (f :: k -> TYPE rep)) where-#else-instance Apply (Codensity f) where-#endif   (<.>) = (<*>)   {-# INLINE (<.>) #-} -#if __GLASGOW_HASKELL__ >= 802 instance Applicative (Codensity (f :: k -> TYPE rep)) where-#else-instance Applicative (Codensity f) where-#endif   pure x = Codensity (\k -> k x)   {-# INLINE pure #-}   Codensity f <*> Codensity g = Codensity (\bfr -> f (\ab -> g (\x -> bfr (ab x))))   {-# INLINE (<*>) #-} -#if __GLASGOW_HASKELL__ >= 802 instance Monad (Codensity (f :: k -> TYPE rep)) where-#else-instance Monad (Codensity f) where-#endif   return = pure   {-# INLINE return #-}   m >>= k = Codensity (\c -> runCodensity m (\a -> runCodensity (k a) c))   {-# INLINE (>>=) #-} -instance Fail.MonadFail f => Fail.MonadFail (Codensity f) where+-- Writing instances like+-- instance MonadFail f => MonadFail (Codensity f)+-- leads to some hidden flexible instances. Haddock will show things like+--+-- MonadFail f => MonadFail (Codensity * LiftedRep f)+--+-- Since FlexibleInstances are bad for inference, we avoid them when+-- we can by carefully pushing kind constraints to the left.++instance (f ~~ f', Fail.MonadFail f')+  => Fail.MonadFail (Codensity (f :: k -> TYPE rep)) where   fail msg = Codensity $ \ _ -> Fail.fail msg   {-# INLINE fail #-} -instance MonadIO m => MonadIO (Codensity m) where+instance (m ~~ m', MonadIO m')+  => MonadIO (Codensity (m :: k -> TYPE rep)) where   liftIO = lift . liftIO   {-# INLINE liftIO #-} @@ -134,11 +113,12 @@   lift m = Codensity (m >>=)   {-# INLINE lift #-} -instance Alt v => Alt (Codensity v) where+instance (v ~~ v', Alt v')+  => Alt (Codensity (v :: k -> TYPE rep)) where   Codensity m <!> Codensity n = Codensity (\k -> m k <!> n k)   {-# INLINE (<!>) #-} -instance Plus v => Plus (Codensity v) where+instance (v ~~ v', Plus v') => Plus (Codensity (v :: k -> TYPE rep)) where   zero = Codensity (const zero)   {-# INLINE zero #-} @@ -152,21 +132,15 @@   mplus = (<!>) -} -instance Alternative v => Alternative (Codensity v) where+instance (v ~~ v', Alternative v')+  => Alternative (Codensity (v :: k -> TYPE rep)) where   empty = Codensity (\_ -> empty)   {-# INLINE empty #-}   Codensity m <|> Codensity n = Codensity (\k -> m k <|> n k)   {-# INLINE (<|>) #-} -#if __GLASGOW_HASKELL__ >= 710-instance Alternative v => MonadPlus (Codensity v)-#else-instance MonadPlus v => MonadPlus (Codensity v) where-  mzero = Codensity (\_ -> mzero)-  {-# INLINE mzero #-}-  Codensity m `mplus` Codensity n = Codensity (\k -> m k `mplus` n k)-  {-# INLINE mplus #-}-#endif+instance (v ~~ v', Alternative v')+   => MonadPlus (Codensity (v :: k -> TYPE rep))  -- | -- This serves as the *left*-inverse (retraction) of 'lift'.@@ -182,13 +156,8 @@ -- e.g. @'Codensity' ((->) s)) a ~ forall r. (a -> s -> r) -> s -> r@ -- could support a full complement of @'MonadState' s@ actions, while @(->) s@ -- is limited to @'MonadReader' s@ actions.-#if __GLASGOW_HASKELL__ >= 710 lowerCodensity :: Applicative f => Codensity f a -> f a lowerCodensity a = runCodensity a pure-#else-lowerCodensity :: Monad m => Codensity m a -> m a-lowerCodensity a = runCodensity a return-#endif {-# INLINE lowerCodensity #-}  -- | The 'Codensity' monad of a right adjoint is isomorphic to the@@ -247,17 +216,20 @@ ranToCodensity (Ran m) = Codensity m {-# INLINE ranToCodensity #-} -instance (Functor f, MonadFree f m) => MonadFree f (Codensity m) where+instance (m ~~ m', Functor f, MonadFree f m')+  => MonadFree f (Codensity (m :: k -> TYPE rep)) where   wrap t = Codensity (\h -> wrap (fmap (\p -> runCodensity p h) t))   {-# INLINE wrap #-} -instance MonadReader r m => MonadState r (Codensity m) where+instance (m ~~ m', MonadReader r m')+  => MonadState r (Codensity (m :: k -> TYPE rep)) where   get = Codensity (ask >>=)   {-# INLINE get #-}   put s = Codensity (\k -> local (const s) (k ()))   {-# INLINE put #-} -instance MonadReader r m => MonadReader r (Codensity m) where+instance (m ~~ m', MonadReader r m')+  => MonadReader r (Codensity (m :: k -> TYPE rep)) where   ask = Codensity (ask >>=)   {-# INLINE ask #-}   local f m = Codensity $ \c -> ask >>= \r -> local f . runCodensity m $ local (const r) . c@@ -297,11 +269,5 @@ -- 'reset' and passes it to @f@: -- -- * @'reset' ('shift' f >>= k) = 'reset' (f ('lowerCodensity' . k))@-shift ::-#if __GLASGOW_HASKELL__ >= 710-  Applicative m-#else-  Monad m-#endif-  => (forall b. (a -> m b) -> Codensity m b) -> Codensity m a+shift :: Applicative m => (forall b. (a -> m b) -> Codensity m b) -> Codensity m a shift f = Codensity $ lowerCodensity . f
src/Data/Functor/Contravariant/Coyoneda.hs view
@@ -1,13 +1,9 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE RankNTypes #-}--#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-}-#endif  ----------------------------------------------------------------------------- -- |
src/Data/Functor/Contravariant/Day.hs view
@@ -1,16 +1,10 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE Rank2Types #-}-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 707+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE DeriveDataTypeable #-}-#endif-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ <= 707 {-# LANGUAGE KindSignatures #-}-#endif-#if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ < 710-{-# LANGUAGE Trustworthy #-}-#endif ----------------------------------------------------------------------------- -- | -- Copyright   :  (C) 2013-2016 Edward Kmett, Gershom Bazerman and Derek Elkins@@ -38,22 +32,18 @@   , trans1, trans2   ) where -#if __GLASGOW_HASKELL__ < 710-import Control.Applicative-#endif+import Control.Arrow ((***)) import Data.Functor.Contravariant import Data.Functor.Contravariant.Rep+import Data.Functor.Contravariant.Adjunction+import Data.Functor.Contravariant.Divisible 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 --@@ -64,26 +54,14 @@ 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 (Divisible f, Divisible g) => Divisible (Day f g) where+  divide h (Day f g l) (Day f' g' r) = Day (divided f f') (divided g g') (intertwine . (l *** r) . h)+    where intertwine ((a, b), (c, d)) = ((a, c), (b, d))+  conquer = Day conquer conquer (\a -> (a, a))+ instance (Representable f, Representable g) => Representable (Day f g) where   type Rep (Day f g) = (Rep f, Rep g) @@ -99,6 +77,9 @@     Right (vf, vg) -> (Right vf, Right vg)   {-# INLINE tabulate #-} +instance (Adjunction f u, Adjunction f' u') => Adjunction (Day f f') (Day u u') where+  unit a = Day (unit a) (unit a) (\(Day f f' g) -> (contramap (fst . g) f, contramap (snd . g) f'))+  counit a = Day (counit a) (counit a) (\(Day u u' g) -> (contramap (fst . g) u, contramap (snd . g) u'))  -- | Break apart the Day convolution of two contravariant functors. runDay :: (Contravariant f, Contravariant g) => Day f g a -> (f a, g a)
src/Data/Functor/Contravariant/Yoneda.hs view
@@ -1,12 +1,9 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE UndecidableInstances #-}-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-}-#endif ----------------------------------------------------------------------------- -- | -- Copyright   :  (C) 2013-2016 Edward Kmett
src/Data/Functor/Coyoneda.hs view
@@ -1,15 +1,10 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE TypeFamilies #-}--#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-}-#endif-#include "kan-extensions-common.h"  ----------------------------------------------------------------------------- -- |@@ -38,9 +33,6 @@ import Control.Comonad import Control.Comonad.Trans.Class import Data.Distributive-#if !LIFTED_FUNCTOR_CLASSES-import Data.Function (on)-#endif import Data.Functor.Adjunction import Data.Functor.Bind import Data.Functor.Classes@@ -151,18 +143,9 @@   {-# INLINE (>>-) #-}  instance Monad m => Monad (Coyoneda m) where-#if __GLASGOW_HASKELL__ < 710-  -- pre-AMP-  return = Coyoneda id . return-  {-# INLINE return #-}--  Coyoneda _ m >> Coyoneda g n = Coyoneda g (m >> n)-  {-# INLINE (>>) #-}-#else-  -- post-AMP   (>>) = (*>)   {-# INLINE (>>) #-}-#endif+   Coyoneda f v >>= k = lift (v >>= lowerM . k . f)   {-# INLINE (>>=) #-} @@ -222,84 +205,40 @@   {-# INLINE collect #-}  instance (Functor f, Show1 f) => Show1 (Coyoneda f) where-#if LIFTED_FUNCTOR_CLASSES   liftShowsPrec sp sl d (Coyoneda f a) =     showsUnaryWith (liftShowsPrec sp sl) "liftCoyoneda" d (fmap f a)   {-# INLINE liftShowsPrec #-}-#else-  showsPrec1 d (Coyoneda f a) = showParen (d > 10) $-    showString "liftCoyoneda " . showsPrec1 11 (fmap f a)-  {-# INLINE showsPrec1 #-}-#endif  instance (Read1 f) => Read1 (Coyoneda f) where-#if LIFTED_FUNCTOR_CLASSES   liftReadsPrec rp rl = readsData $     readsUnaryWith (liftReadsPrec rp rl) "liftCoyoneda" liftCoyoneda   {-# INLINE liftReadsPrec #-}-#else-  readsPrec1 d = readParen (d > 10) $ \r' ->-    [ (liftCoyoneda f, t)-    | ("liftCoyoneda", s) <- lex r'-    , (f, t) <- readsPrec1 11 s-    ]-  {-# INLINE readsPrec1 #-}-#endif  instance (Functor f, Show1 f, Show a) => Show (Coyoneda f a) where   showsPrec = showsPrec1   {-# INLINE showsPrec #-}  instance Read (f a) => Read (Coyoneda f a) where-#ifdef __GLASGOW_HASKELL__   readPrec = parens $ prec 10 $ do     Ident "liftCoyoneda" <- lexP     liftCoyoneda <$> step readPrec   {-# INLINE readPrec #-}-#else-  readsPrec d = readParen (d > 10) $ \r' ->-    [ (liftCoyoneda f, t)-    | ("liftCoyoneda", s) <- lex r'-    , (f, t) <- readsPrec 11 s-    ]-  {-# INLINE readsPrec #-}-#endif -#if LIFTED_FUNCTOR_CLASSES instance Eq1 f => Eq1 (Coyoneda f) where   liftEq eq (Coyoneda f xs) (Coyoneda g ys) =     liftEq (\x y -> eq (f x) (g y)) xs ys   {-# INLINE liftEq #-}-#else-instance (Functor f, Eq1 f) => Eq1 (Coyoneda f) where-  eq1 = eq1 `on` lowerCoyoneda-  {-# INLINE eq1 #-}-#endif -#if LIFTED_FUNCTOR_CLASSES instance Ord1 f => Ord1 (Coyoneda f) where   liftCompare cmp (Coyoneda f xs) (Coyoneda g ys) =     liftCompare (\x y -> cmp (f x) (g y)) xs ys   {-# INLINE liftCompare #-}-#else-instance (Functor f, Ord1 f) => Ord1 (Coyoneda f) where-  compare1 = compare1 `on` lowerCoyoneda-  {-# INLINE compare1 #-}-#endif -instance ( Eq1 f, Eq a-#if !LIFTED_FUNCTOR_CLASSES-         , Functor f-#endif-         ) => Eq (Coyoneda f a) where+instance (Eq1 f, Eq a) => Eq (Coyoneda f a) where   (==) = eq1   {-# INLINE (==) #-} -instance ( Ord1 f, Ord a-#if !LIFTED_FUNCTOR_CLASSES-         , Functor f-#endif-         ) => Ord (Coyoneda f a) where+instance (Ord1 f, Ord a) => Ord (Coyoneda f a) where   compare = compare1   {-# INLINE compare #-}
src/Data/Functor/Day.hs view
@@ -1,9 +1,10 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE UndecidableInstances #-} ----------------------------------------------------------------------------- -- | -- Copyright   :  (C) 2014-2016 Edward Kmett@@ -45,40 +46,20 @@ import Data.Distributive import Data.Profunctor.Cayley (Cayley(..)) import Data.Profunctor.Composition (Procompose(..))+import Data.Functor.Adjunction import Data.Functor.Identity import Data.Functor.Rep-#ifdef __GLASGOW_HASKELL__ import Data.Typeable-#endif import Prelude hiding (id,(.))  -- | The Day convolution of two covariant functors. 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) @@ -100,6 +81,13 @@   tabulate f = Day (tabulate id) (tabulate id) (curry f)   index (Day m n o) (x,y) = o (index m x) (index n y) +instance (Adjunction f u, Adjunction f' u') => Adjunction (Day f f') (Day u u') where+  unit a = Day (unit ()) (unit ()) (\f f' -> Day f f' (\() () -> a))+  counit (Day f f' h) = case h a a' of Day u u' g -> g (indexAdjunction u f_) (indexAdjunction u' f_')+    where+      (a, f_) = splitL f+      (a', f_') = splitL f'+ instance (Comonad f, Comonad g) => Comonad (Day f g) where   extract (Day fb gc bca) = bca (extract fb) (extract gc)   duplicate (Day fb gc bca) = Day (duplicate fb) (duplicate gc) (\fb' gc' -> Day fb' gc' bca)@@ -182,7 +170,7 @@  -- | Collapse via a monoidal functor. ----- @ +-- @ -- 'dap' ('day' f g) = f '<*>' g -- @ dap :: Applicative f => Day f f a -> f a
src/Data/Functor/Day/Curried.hs view
@@ -1,11 +1,6 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE TypeOperators #-}--#if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ < 710-{-# LANGUAGE Trustworthy #-}-#endif ------------------------------------------------------------------------------------------- -- | -- Copyright 	: 2013-2016 Edward Kmett and Dan Doel@@ -32,12 +27,11 @@   , liftCurried, lowerCurried, rap   ) where -#if __GLASGOW_HASKELL__ < 710-import Control.Applicative-#endif+import qualified Control.Applicative as App import Data.Functor.Adjunction import Data.Functor.Day import Data.Functor.Identity+import Data.Functor.Apply  newtype Curried g h a =   Curried { runCurried :: forall r. g (a -> r) -> h r }@@ -46,11 +40,19 @@   fmap f (Curried g) = Curried (g . fmap (.f))   {-# INLINE fmap #-} -instance (Functor g, g ~ h) => Applicative (Curried g h) where+instance (Functor g, g ~ h) => Apply (Curried g h) where+  Curried mf <.> Curried ma = Curried (ma . mf . fmap (.))+  {-# INLINE (<.>) #-}+  liftF2 f (Curried g) (Curried ma) = Curried (ma . g . fmap (\p q -> p . f q))+  {-# INLINE liftF2 #-}++instance (Functor g, g ~ h) => App.Applicative (Curried g h) where   pure a = Curried (fmap ($ a))   {-# INLINE pure #-}   Curried mf <*> Curried ma = Curried (ma . mf . fmap (.))   {-# INLINE (<*>) #-}+  liftA2 f (Curried g) (Curried ma) = Curried (ma . g . fmap (\p q -> p . f q))+  {-# INLINE liftA2 #-}  -- | The natural isomorphism between @f@ and @Curried f f@. -- @
src/Data/Functor/Kan/Lan.hs view
@@ -1,12 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE Rank2Types #-}-#if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-}-#endif-#if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ < 710-{-# LANGUAGE Trustworthy #-}-#endif ------------------------------------------------------------------------------------------- -- | -- Copyright 	: 2008-2016 Edward Kmett@@ -29,7 +24,9 @@   , composedAdjointToLan, lanToComposedAdjoint   ) where +#if !(MIN_VERSION_base(4,18,0)) import Control.Applicative+#endif import Data.Functor.Adjunction import Data.Functor.Apply import Data.Functor.Composition
src/Data/Functor/Kan/Ran.hs view
@@ -1,11 +1,6 @@ {-# LANGUAGE Rank2Types, GADTs #-}-{-# LANGUAGE CPP #-}-#if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-}-#endif-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-}-#endif ------------------------------------------------------------------------------------------- -- | -- Copyright 	: 2008-2016 Edward Kmett
src/Data/Functor/Yoneda.hs view
@@ -1,14 +1,10 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-}-#endif-#include "kan-extensions-common.h"  ----------------------------------------------------------------------------- -- |@@ -158,64 +154,33 @@   {-# INLINE counit #-}  instance Show1 f => Show1 (Yoneda f) where-#if LIFTED_FUNCTOR_CLASSES   liftShowsPrec sp sl d (Yoneda f) =     showsUnaryWith (liftShowsPrec sp sl) "liftYoneda" d (f id)-#else-  showsPrec1 d (Yoneda f) = showParen (d > 10) $-    showString "liftYoneda " . showsPrec1 11 (f id)-#endif  instance (Read1 f, Functor f) => Read1 (Yoneda f) where-#if LIFTED_FUNCTOR_CLASSES   liftReadsPrec rp rl = readsData $     readsUnaryWith (liftReadsPrec rp rl) "liftYoneda" liftYoneda-#else-  readsPrec1 d = readParen (d > 10) $ \r' ->-    [ (liftYoneda f, t)-    | ("liftYoneda", s) <- lex r'-    , (f, t) <- readsPrec1 11 s-    ]-#endif  instance Show (f a) => Show (Yoneda f a) where   showsPrec d (Yoneda f) = showParen (d > 10) $     showString "liftYoneda " . showsPrec 11 (f id)  instance (Functor f, Read (f a)) => Read (Yoneda f a) where-#ifdef __GLASGOW_HASKELL__   readPrec = parens $ prec 10 $ do      Ident "liftYoneda" <- lexP      liftYoneda <$> step readPrec-#else-  readsPrec d = readParen (d > 10) $ \r' ->-    [ (liftYoneda f, t)-    | ("liftYoneda", s) <- lex r'-    , (f, t) <- readsPrec 11 s-    ]-#endif  infixl 0 `on1` on1 :: (g a -> g b -> c) -> (forall x. f x -> g x) -> f a -> f b -> c (.*.) `on1` f = \x y -> f x .*. f y  instance Eq1 f => Eq1 (Yoneda f) where-#if LIFTED_FUNCTOR_CLASSES   liftEq eq = liftEq eq `on1` lowerYoneda   {-# INLINE liftEq #-}-#else-  eq1 = eq1 `on1` lowerYoneda-  {-# INLINE eq1 #-}-#endif  instance Ord1 f => Ord1 (Yoneda f) where-#if LIFTED_FUNCTOR_CLASSES   liftCompare cmp = liftCompare cmp `on1` lowerYoneda   {-# INLINE liftCompare #-}-#else-  compare1 = compare1 `on1` lowerYoneda-  {-# INLINE compare1 #-}-#endif  instance (Eq1 f, Eq a) => Eq (Yoneda f a) where   (==) = eq1@@ -264,10 +229,6 @@   {-# INLINE (>>-) #-}  instance Monad m => Monad (Yoneda m) where-#if __GLASGOW_HASKELL__ < 710-  return a = Yoneda (\f -> return (f a))-  {-# INLINE return #-}-#endif   Yoneda m >>= k = Yoneda (\f -> m id >>= \a -> runYoneda (k a) f)   {-# INLINE (>>=) #-}