Migrate Contravariant instances
authorryan.gl.scott <ryan.gl.scott@gmail.com>
Thu, 19 Apr 2018 21:02:38 +0000 (21:02 +0000)
committerryan.gl.scott <ryan.gl.scott@gmail.com>
Thu, 19 Apr 2018 21:02:38 +0000 (21:02 +0000)
These were originally defined in the contravariant library. The
Data.Contravariant module will be moved to base in base-4.12
(GHC 8.6), so this commit moves the corresponding instances to
transformers to accommodate the migration.

18 files changed:
Control/Applicative/Backwards.hs
Control/Monad/Trans/Error.hs
Control/Monad/Trans/Except.hs
Control/Monad/Trans/Identity.hs
Control/Monad/Trans/List.hs
Control/Monad/Trans/Maybe.hs
Control/Monad/Trans/RWS/Lazy.hs
Control/Monad/Trans/RWS/Strict.hs
Control/Monad/Trans/Reader.hs
Control/Monad/Trans/State/Lazy.hs
Control/Monad/Trans/State/Strict.hs
Control/Monad/Trans/Writer/Lazy.hs
Control/Monad/Trans/Writer/Strict.hs
Data/Functor/Constant.hs
Data/Functor/Reverse.hs
legacy/pre711/Data/Functor/Compose.hs
legacy/pre711/Data/Functor/Product.hs
legacy/pre711/Data/Functor/Sum.hs

index ebb8a0b..7ed74ac 100644 (file)
@@ -27,6 +27,9 @@ module Control.Applicative.Backwards (
   ) where
 
 import Data.Functor.Classes
+#if MIN_VERSION_base(4,12,0)
+import Data.Functor.Contravariant
+#endif
 
 import Prelude hiding (foldr, foldr1, foldl, foldl1, null, length)
 import Control.Applicative
@@ -100,3 +103,10 @@ instance (Traversable f) => Traversable (Backwards f) where
     {-# INLINE traverse #-}
     sequenceA (Backwards t) = fmap Backwards (sequenceA t)
     {-# INLINE sequenceA #-}
+
+#if MIN_VERSION_base(4,12,0)
+-- | Derived instance.
+instance Contravariant f => Contravariant (Backwards f) where
+    contramap f = Backwards . contramap f . forwards
+    {-# INLINE contramap #-}
+#endif
index 144da45..f50b051 100644 (file)
@@ -58,6 +58,9 @@ import Control.Monad.IO.Class
 import Control.Monad.Signatures
 import Control.Monad.Trans.Class
 import Data.Functor.Classes
+#if MIN_VERSION_base(4,12,0)
+import Data.Functor.Contravariant
+#endif
 
 import Control.Applicative
 import Control.Exception (IOException)
@@ -263,6 +266,11 @@ instance MonadTrans (ErrorT e) where
 instance (Error e, MonadIO m) => MonadIO (ErrorT e m) where
     liftIO = lift . liftIO
 
+#if MIN_VERSION_base(4,12,0)
+instance Contravariant m => Contravariant (ErrorT e m) where
+    contramap f = ErrorT . contramap (fmap f) . runErrorT
+#endif
+
 -- | Signal an error value @e@.
 --
 -- * @'runErrorT' ('throwError' e) = 'return' ('Left' e)@
index 7421930..b5446e4 100644 (file)
@@ -51,6 +51,9 @@ import Control.Monad.IO.Class
 import Control.Monad.Signatures
 import Control.Monad.Trans.Class
 import Data.Functor.Classes
+#if MIN_VERSION_base(4,12,0)
+import Data.Functor.Contravariant
+#endif
 import Data.Functor.Identity
 
 import Control.Applicative
@@ -255,6 +258,12 @@ instance (MonadZip m) => MonadZip (ExceptT e m) where
     {-# INLINE mzipWith #-}
 #endif
 
+#if MIN_VERSION_base(4,12,0)
+instance Contravariant m => Contravariant (ExceptT e m) where
+    contramap f = ExceptT . contramap (fmap f) . runExceptT
+    {-# INLINE contramap #-}
+#endif
+
 -- | Signal an exception value @e@.
 --
 -- * @'runExceptT' ('throwE' e) = 'return' ('Left' e)@
index b04428e..81d0c21 100644 (file)
@@ -36,6 +36,9 @@ import Control.Monad.IO.Class (MonadIO(liftIO))
 import Control.Monad.Signatures
 import Control.Monad.Trans.Class (MonadTrans(lift))
 import Data.Functor.Classes
+#if MIN_VERSION_base(4,12,0)
+import Data.Functor.Contravariant
+#endif
 
 import Control.Applicative
 import Control.Monad (MonadPlus(mzero, mplus))
@@ -154,6 +157,12 @@ instance MonadTrans IdentityT where
     lift = IdentityT
     {-# INLINE lift #-}
 
+#if MIN_VERSION_base(4,12,0)
+instance Contravariant f => Contravariant (IdentityT f) where
+    contramap f = IdentityT . contramap f . runIdentityT
+    {-# INLINE contramap #-}
+#endif
+
 -- | Lift a unary operation to the new monad.
 mapIdentityT :: (m a -> n b) -> IdentityT m a -> IdentityT n b
 mapIdentityT f = IdentityT . f . runIdentityT
index cebbee7..6af4b10 100644 (file)
@@ -34,6 +34,9 @@ import Control.Monad.IO.Class
 import Control.Monad.Signatures
 import Control.Monad.Trans.Class
 import Data.Functor.Classes
+#if MIN_VERSION_base(4,12,0)
+import Data.Functor.Contravariant
+#endif
 
 import Control.Applicative
 import Control.Monad
@@ -160,6 +163,12 @@ instance (MonadZip m) => MonadZip (ListT m) where
     {-# INLINE mzipWith #-}
 #endif
 
+#if MIN_VERSION_base(4,12,0)
+instance Contravariant m => Contravariant (ListT m) where
+    contramap f = ListT . contramap (fmap f) . runListT
+    {-# INLINE contramap #-}
+#endif
+
 -- | Lift a @callCC@ operation to the new monad.
 liftCallCC :: CallCC m [a] [b] -> CallCC (ListT m) a b
 liftCallCC callCC f = ListT $
index 13114b1..997a4c0 100644 (file)
@@ -45,6 +45,9 @@ import Control.Monad.Signatures
 import Control.Monad.Trans.Class
 import Control.Monad.Trans.Except (ExceptT(..))
 import Data.Functor.Classes
+#if MIN_VERSION_base(4,12,0)
+import Data.Functor.Contravariant
+#endif
 
 import Control.Applicative
 import Control.Monad (MonadPlus(mzero, mplus), liftM)
@@ -202,6 +205,12 @@ instance (MonadZip m) => MonadZip (MaybeT m) where
     {-# INLINE mzipWith #-}
 #endif
 
+#if MIN_VERSION_base(4,12,0)
+instance Contravariant m => Contravariant (MaybeT m) where
+    contramap f = MaybeT . contramap (fmap f) . runMaybeT
+    {-# INLINE contramap #-}
+#endif
+
 -- | Lift a @callCC@ operation to the new monad.
 liftCallCC :: CallCC m (Maybe a) (Maybe b) -> CallCC (MaybeT m) a b
 liftCallCC callCC f =
index 36694c5..c366d5d 100644 (file)
@@ -63,6 +63,9 @@ module Control.Monad.Trans.RWS.Lazy (
 import Control.Monad.IO.Class
 import Control.Monad.Signatures
 import Control.Monad.Trans.Class
+#if MIN_VERSION_base(4,12,0)
+import Data.Functor.Contravariant
+#endif
 import Data.Functor.Identity
 
 import Control.Applicative
@@ -231,6 +234,13 @@ instance (Monoid w, MonadIO m) => MonadIO (RWST r w s m) where
     liftIO = lift . liftIO
     {-# INLINE liftIO #-}
 
+#if MIN_VERSION_base(4,12,0)
+instance Contravariant m => Contravariant (RWST r w s m) where
+    contramap f m = RWST $ \r s ->
+      contramap (\ ~(a, s', w) -> (f a, s', w)) $ runRWST m r s
+    {-# INLINE contramap #-}
+#endif
+
 -- ---------------------------------------------------------------------------
 -- Reader operations
 
index 32f2af5..c5e3f6c 100644 (file)
@@ -63,6 +63,9 @@ module Control.Monad.Trans.RWS.Strict (
 import Control.Monad.IO.Class
 import Control.Monad.Signatures
 import Control.Monad.Trans.Class
+#if MIN_VERSION_base(4,12,0)
+import Data.Functor.Contravariant
+#endif
 import Data.Functor.Identity
 
 import Control.Applicative
@@ -231,6 +234,13 @@ instance (Monoid w, MonadIO m) => MonadIO (RWST r w s m) where
     liftIO = lift . liftIO
     {-# INLINE liftIO #-}
 
+#if MIN_VERSION_base(4,12,0)
+instance Contravariant m => Contravariant (RWST r w s m) where
+    contramap f m = RWST $ \r s ->
+      contramap (\ (a, s', w) -> (f a, s', w)) $ runRWST m r s
+    {-# INLINE contramap #-}
+#endif
+
 -- ---------------------------------------------------------------------------
 -- Reader operations
 
index b577b2d..f0b80f7 100644 (file)
@@ -49,6 +49,9 @@ module Control.Monad.Trans.Reader (
 import Control.Monad.IO.Class
 import Control.Monad.Signatures
 import Control.Monad.Trans.Class
+#if MIN_VERSION_base(4,12,0)
+import Data.Functor.Contravariant
+#endif
 import Data.Functor.Identity
 
 import Control.Applicative
@@ -207,6 +210,12 @@ instance (MonadZip m) => MonadZip (ReaderT r m) where
     {-# INLINE mzipWith #-}
 #endif
 
+#if MIN_VERSION_base(4,12,0)
+instance Contravariant m => Contravariant (ReaderT r m) where
+    contramap f = ReaderT . fmap (contramap f) . runReaderT
+    {-# INLINE contramap #-}
+#endif
+
 liftReaderT :: m a -> ReaderT r m a
 liftReaderT m = ReaderT (const m)
 {-# INLINE liftReaderT #-}
index 13f61f4..e719f02 100644 (file)
@@ -76,6 +76,9 @@ module Control.Monad.Trans.State.Lazy (
 import Control.Monad.IO.Class
 import Control.Monad.Signatures
 import Control.Monad.Trans.Class
+#if MIN_VERSION_base(4,12,0)
+import Data.Functor.Contravariant
+#endif
 import Data.Functor.Identity
 
 import Control.Applicative
@@ -253,6 +256,13 @@ instance (MonadIO m) => MonadIO (StateT s m) where
     liftIO = lift . liftIO
     {-# INLINE liftIO #-}
 
+#if MIN_VERSION_base(4,12,0)
+instance Contravariant m => Contravariant (StateT s m) where
+    contramap f m = StateT $ \s ->
+      contramap (\ ~(a, s') -> (f a, s')) $ runStateT m s
+    {-# INLINE contramap #-}
+#endif
+
 -- | Fetch the current value of the state within the monad.
 get :: (Monad m) => StateT s m s
 get = state $ \ s -> (s, s)
index f1fb782..31fd52a 100644 (file)
@@ -73,6 +73,9 @@ module Control.Monad.Trans.State.Strict (
 import Control.Monad.IO.Class
 import Control.Monad.Signatures
 import Control.Monad.Trans.Class
+#if MIN_VERSION_base(4,12,0)
+import Data.Functor.Contravariant
+#endif
 import Data.Functor.Identity
 
 import Control.Applicative
@@ -250,6 +253,13 @@ instance (MonadIO m) => MonadIO (StateT s m) where
     liftIO = lift . liftIO
     {-# INLINE liftIO #-}
 
+#if MIN_VERSION_base(4,12,0)
+instance Contravariant m => Contravariant (StateT s m) where
+    contramap f m = StateT $ \s ->
+      contramap (\ (a, s') -> (f a, s')) $ runStateT m s
+    {-# INLINE contramap #-}
+#endif
+
 -- | Fetch the current value of the state within the monad.
 get :: (Monad m) => StateT s m s
 get = state $ \ s -> (s, s)
index c7f689c..721e15c 100644 (file)
@@ -52,6 +52,9 @@ module Control.Monad.Trans.Writer.Lazy (
 import Control.Monad.IO.Class
 import Control.Monad.Trans.Class
 import Data.Functor.Classes
+#if MIN_VERSION_base(4,12,0)
+import Data.Functor.Contravariant
+#endif
 import Data.Functor.Identity
 
 import Control.Applicative
@@ -237,6 +240,12 @@ instance (Monoid w, MonadZip m) => MonadZip (WriterT w m) where
     {-# INLINE mzipWith #-}
 #endif
 
+#if MIN_VERSION_base(4,12,0)
+instance Contravariant m => Contravariant (WriterT w m) where
+    contramap f = mapWriterT $ contramap $ \ ~(a, w) -> (f a, w)
+    {-# INLINE contramap #-}
+#endif
+
 -- | @'tell' w@ is an action that produces the output @w@.
 tell :: (Monad m) => w -> WriterT w m ()
 tell w = writer ((), w)
index 33058af..b18b4a8 100644 (file)
@@ -55,6 +55,9 @@ module Control.Monad.Trans.Writer.Strict (
 import Control.Monad.IO.Class
 import Control.Monad.Trans.Class
 import Data.Functor.Classes
+#if MIN_VERSION_base(4,12,0)
+import Data.Functor.Contravariant
+#endif
 import Data.Functor.Identity
 
 import Control.Applicative
@@ -240,6 +243,12 @@ instance (Monoid w, MonadZip m) => MonadZip (WriterT w m) where
     {-# INLINE mzipWith #-}
 #endif
 
+#if MIN_VERSION_base(4,12,0)
+instance Contravariant m => Contravariant (WriterT w m) where
+    contramap f = mapWriterT $ contramap $ \ (a, w) -> (f a, w)
+    {-# INLINE contramap #-}
+#endif
+
 -- | @'tell' w@ is an action that produces the output @w@.
 tell :: (Monad m) => w -> WriterT w m ()
 tell w = writer ((), w)
index e22f0d6..9c0b8d4 100644 (file)
@@ -26,6 +26,9 @@ module Data.Functor.Constant (
   ) where
 
 import Data.Functor.Classes
+#if MIN_VERSION_base(4,12,0)
+import Data.Functor.Contravariant
+#endif
 
 import Control.Applicative
 import Data.Foldable
@@ -141,3 +144,9 @@ instance Bitraversable Constant where
     bitraverse f _ (Constant a) = Constant <$> f a
     {-# INLINE bitraverse #-}
 #endif
+
+#if MIN_VERSION_base(4,12,0)
+instance Contravariant (Constant a) where
+    contramap _ (Constant a) = Constant a
+    {-# INLINE contramap #-}
+#endif
index a6abc46..dcb6290 100644 (file)
@@ -28,6 +28,9 @@ module Data.Functor.Reverse (
 
 import Control.Applicative.Backwards
 import Data.Functor.Classes
+#if MIN_VERSION_base(4,12,0)
+import Data.Functor.Contravariant
+#endif
 
 import Prelude hiding (foldr, foldr1, foldl, foldl1, null, length)
 import Control.Applicative
@@ -129,3 +132,10 @@ instance (Traversable f) => Traversable (Reverse f) where
     traverse f (Reverse t) =
         fmap Reverse . forwards $ traverse (Backwards . f) t
     {-# INLINE traverse #-}
+
+#if MIN_VERSION_base(4,12,0)
+-- | Derived instance.
+instance Contravariant f => Contravariant (Reverse f) where
+    contramap f = Reverse . contramap f . getReverse
+    {-# INLINE contramap #-}
+#endif
index 161a2e9..ed78130 100644 (file)
@@ -35,6 +35,9 @@ module Data.Functor.Compose (
   ) where
 
 import Data.Functor.Classes
+#if MIN_VERSION_base(4,12,0)
+import Data.Functor.Contravariant
+#endif
 
 import Control.Applicative
 #if __GLASGOW_HASKELL__ >= 708
@@ -144,3 +147,8 @@ instance (Applicative f, Applicative g) => Applicative (Compose f g) where
 instance (Alternative f, Applicative g) => Alternative (Compose f g) where
     empty = Compose empty
     Compose x <|> Compose y = Compose (x <|> y)
+
+#if MIN_VERSION_base(4,12,0)
+instance (Functor f, Contravariant g) => Contravariant (Compose f g) where
+    contramap f (Compose fga) = Compose (fmap (contramap f) fga)
+#endif
index 51c99a3..ba0dc04 100644 (file)
@@ -45,6 +45,9 @@ import Data.Data
 #endif
 import Data.Foldable (Foldable(foldMap))
 import Data.Functor.Classes
+#if MIN_VERSION_base(4,12,0)
+import Data.Functor.Contravariant
+#endif
 import Data.Monoid (mappend)
 import Data.Traversable (Traversable(traverse))
 #if __GLASGOW_HASKELL__ >= 702
@@ -146,3 +149,8 @@ instance (MonadFix f, MonadFix g) => MonadFix (Product f g) where
 instance (MonadZip f, MonadZip g) => MonadZip (Product f g) where
     mzipWith f (Pair x1 y1) (Pair x2 y2) = Pair (mzipWith f x1 x2) (mzipWith f y1 y2)
 #endif
+
+#if MIN_VERSION_base(4,12,0)
+instance (Contravariant f, Contravariant g) => Contravariant (Product f g) where
+    contramap f (Pair a b) = Pair (contramap f a) (contramap f b)
+#endif
index 9c314e7..e6d1428 100644 (file)
@@ -40,6 +40,9 @@ import Data.Data
 #endif
 import Data.Foldable (Foldable(foldMap))
 import Data.Functor.Classes
+#if MIN_VERSION_base(4,12,0)
+import Data.Functor.Contravariant
+#endif
 import Data.Monoid (mappend)
 import Data.Traversable (Traversable(traverse))
 #if __GLASGOW_HASKELL__ >= 702
@@ -125,3 +128,9 @@ instance (Foldable f, Foldable g) => Foldable (Sum f g) where
 instance (Traversable f, Traversable g) => Traversable (Sum f g) where
     traverse f (InL x) = InL <$> traverse f x
     traverse f (InR y) = InR <$> traverse f y
+
+#if MIN_VERSION_base(4,12,0)
+instance (Contravariant f, Contravariant g) => Contravariant (Sum f g) where
+    contramap f (InL xs) = InL (contramap f xs)
+    contramap f (InR ys) = InR (contramap f ys)
+#endif