MonadZip instaces, base-4.8.0.0 compatibility with Identity
authorryan.gl.scott <ryan.gl.scott@ku.edu>
Mon, 13 Apr 2015 18:52:37 +0000 (18:52 +0000)
committerryan.gl.scott <ryan.gl.scott@ku.edu>
Mon, 13 Apr 2015 18:52:37 +0000 (18:52 +0000)
12 files changed:
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/Reader.hs
Control/Monad/Trans/Writer/Lazy.hs
Control/Monad/Trans/Writer/Strict.hs
Data/Functor/Classes.hs
Data/Functor/Product.hs
oldsrc/Data/Functor/Identity.hs
transformers.cabal

index cdda5b1..2b016f2 100644 (file)
@@ -61,6 +61,9 @@ import Control.Monad.Fix
 #if !(MIN_VERSION_base(4,6,0))
 import Control.Monad.Instances ()  -- deprecated from base-4.6
 #endif
+#if MIN_VERSION_base(4,4,0)
+import Control.Monad.Zip (MonadZip(mzipWith))
+#endif
 import Data.Foldable (Foldable(foldMap))
 import Data.Monoid (mempty)
 import Data.Traversable (Traversable(traverse))
@@ -242,6 +245,11 @@ instance MonadTrans (ErrorT e) where
 instance (Error e, MonadIO m) => MonadIO (ErrorT e m) where
     liftIO = lift . liftIO
 
+#if MIN_VERSION_base(4,4,0)
+instance (MonadZip m, Error e) => MonadZip (ErrorT e m) where
+    mzipWith f (ErrorT a) (ErrorT b) = ErrorT $ mzipWith (liftA2 f) a b
+#endif
+
 -- | Signal an error value @e@.
 --
 -- * @'runErrorT' ('throwError' e) = 'return' ('Left' e)@
index 92d7dcf..f039098 100644 (file)
@@ -53,6 +53,9 @@ import Data.Functor.Identity
 import Control.Applicative
 import Control.Monad
 import Control.Monad.Fix
+#if MIN_VERSION_base(4,4,0)
+import Control.Monad.Zip (MonadZip(mzipWith))
+#endif
 import Data.Foldable (Foldable(foldMap))
 import Data.Monoid
 import Data.Traversable (Traversable(traverse))
@@ -194,6 +197,11 @@ instance MonadTrans (ExceptT e) where
 instance (MonadIO m) => MonadIO (ExceptT e m) where
     liftIO = lift . liftIO
 
+#if MIN_VERSION_base(4,4,0)
+instance (MonadZip m) => MonadZip (ExceptT e m) where
+    mzipWith f (ExceptT a) (ExceptT b) = ExceptT $ mzipWith (liftA2 f) a b
+#endif
+
 -- | Signal an exception value @e@.
 --
 -- * @'runExceptT' ('throwE' e) = 'return' ('Left' e)@
index 6639aa3..4f89c18 100644 (file)
@@ -34,6 +34,9 @@ import Data.Functor.Classes
 import Control.Applicative
 import Control.Monad (MonadPlus(mzero, mplus))
 import Control.Monad.Fix (MonadFix(mfix))
+#if MIN_VERSION_base(4,4,0)
+import Control.Monad.Zip (MonadZip(mzipWith))
+#endif
 import Data.Foldable (Foldable(foldMap))
 import Data.Traversable (Traversable(traverse))
 
@@ -91,6 +94,11 @@ instance (MonadFix m) => MonadFix (IdentityT m) where
 instance (MonadIO m) => MonadIO (IdentityT m) where
     liftIO = IdentityT . liftIO
 
+#if MIN_VERSION_base(4,4,0)
+instance (MonadZip m) => MonadZip (IdentityT m) where
+    mzipWith f = lift2IdentityT (mzipWith f)
+#endif
+
 instance MonadTrans IdentityT where
     lift = IdentityT
 
index 09f9f47..8c4d5af 100644 (file)
@@ -33,6 +33,9 @@ import Data.Functor.Classes
 
 import Control.Applicative
 import Control.Monad
+#if MIN_VERSION_base(4,4,0)
+import Control.Monad.Zip (MonadZip(mzipWith))
+#endif
 import Data.Foldable (Foldable(foldMap))
 import Data.Traversable (Traversable(traverse))
 
@@ -106,6 +109,11 @@ instance MonadTrans ListT where
 instance (MonadIO m) => MonadIO (ListT m) where
     liftIO = lift . liftIO
 
+#if MIN_VERSION_base(4,4,0)
+instance (MonadZip m) => MonadZip (ListT m) where
+    mzipWith f (ListT a) (ListT b) = ListT $ mzipWith (zipWith f) a b
+#endif
+
 -- | Lift a @callCC@ operation to the new monad.
 liftCallCC :: CallCC m [a] [b] -> CallCC (ListT m) a b
 liftCallCC callCC f = ListT $
index e014ac4..67d2235 100644 (file)
@@ -46,6 +46,9 @@ import Data.Functor.Classes
 import Control.Applicative
 import Control.Monad (MonadPlus(mzero, mplus), liftM, ap)
 import Control.Monad.Fix (MonadFix(mfix))
+#if MIN_VERSION_base(4,4,0)
+import Control.Monad.Zip (MonadZip(mzipWith))
+#endif
 import Data.Foldable (Foldable(foldMap))
 import Data.Maybe (fromMaybe)
 import Data.Traversable (Traversable(traverse))
@@ -139,6 +142,11 @@ instance MonadTrans MaybeT where
 instance (MonadIO m) => MonadIO (MaybeT m) where
     liftIO = lift . liftIO
 
+#if MIN_VERSION_base(4,4,0)
+instance (MonadZip m) => MonadZip (MaybeT m) where
+    mzipWith f (MaybeT a) (MaybeT b) = MaybeT $ mzipWith (liftA2 f) a b
+#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 4c63e48..b36c1ad 100644 (file)
@@ -51,6 +51,9 @@ import Control.Monad.Fix
 #if !(MIN_VERSION_base(4,6,0))
 import Control.Monad.Instances ()  -- deprecated from base-4.6
 #endif
+#if MIN_VERSION_base(4,4,0)
+import Control.Monad.Zip (MonadZip(mzipWith))
+#endif
 
 -- | The parameterizable reader monad.
 --
@@ -142,6 +145,12 @@ instance MonadTrans (ReaderT r) where
 instance (MonadIO m) => MonadIO (ReaderT r m) where
     liftIO = lift . liftIO
 
+#if MIN_VERSION_base(4,4,0)
+instance (MonadZip m) => MonadZip (ReaderT r m) where
+    mzipWith f (ReaderT m) (ReaderT n) = ReaderT $ \ a ->
+        mzipWith f (m a) (n a)
+#endif
+
 liftReaderT :: m a -> ReaderT r m a
 liftReaderT m = ReaderT (const m)
 
index 4d1fb74..f1ad04a 100644 (file)
@@ -55,6 +55,9 @@ import Control.Applicative
 import Control.Monad
 import Control.Monad.Fix
 import Control.Monad.Signatures
+#if MIN_VERSION_base(4,4,0)
+import Control.Monad.Zip (MonadZip(mzipWith))
+#endif
 import Data.Foldable (Foldable(foldMap))
 import Data.Monoid
 import Data.Traversable (Traversable(traverse))
@@ -180,6 +183,12 @@ instance (Monoid w) => MonadTrans (WriterT w) where
 instance (Monoid w, MonadIO m) => MonadIO (WriterT w m) where
     liftIO = lift . liftIO
 
+#if MIN_VERSION_base(4,4,0)
+instance (Monoid w, MonadZip m) => MonadZip (WriterT w m) where
+    mzipWith f (WriterT x) (WriterT y) = WriterT $
+        mzipWith (\ ~(a, w) ~(b, w') -> (f a b, w `mappend` w')) x y
+#endif
+
 -- | @'tell' w@ is an action that produces the output @w@.
 tell :: (Monad m) => w -> WriterT w m ()
 tell w = writer ((), w)
index 148661d..350334e 100644 (file)
@@ -58,6 +58,9 @@ import Control.Applicative
 import Control.Monad
 import Control.Monad.Fix
 import Control.Monad.Signatures
+#if MIN_VERSION_base(4,4,0)
+import Control.Monad.Zip (MonadZip(mzipWith))
+#endif
 import Data.Foldable (Foldable(foldMap))
 import Data.Monoid
 import Data.Traversable (Traversable(traverse))
@@ -183,6 +186,12 @@ instance (Monoid w) => MonadTrans (WriterT w) where
 instance (Monoid w, MonadIO m) => MonadIO (WriterT w m) where
     liftIO = lift . liftIO
 
+#if MIN_VERSION_base(4,4,0)
+instance (Monoid w, MonadZip m) => MonadZip (WriterT w m) where
+    mzipWith f (WriterT x) (WriterT y) = WriterT $
+        mzipWith (\ (a, w) (b, w') -> (f a b, w `mappend` w')) x y
+#endif
+
 -- | @'tell' w@ is an action that produces the output @w@.
 tell :: (Monad m) => w -> WriterT w m ()
 tell w = writer ((), w)
index a721721..7d5c59d 100644 (file)
@@ -64,6 +64,7 @@ module Data.Functor.Classes (
 
 import Control.Applicative (Const(Const))
 import Data.Functor.Identity (Identity(Identity))
+import Data.Monoid (mappend)
 
 -- | Lifting of the 'Eq' class to unary type constructors.
 class Eq1 f where
index ef3d0e4..6e99951 100644 (file)
@@ -22,6 +22,9 @@ module Data.Functor.Product (
 import Control.Applicative
 import Control.Monad (MonadPlus(..))
 import Control.Monad.Fix (MonadFix(..))
+#if MIN_VERSION_base(4,4,0)
+import Control.Monad.Zip (MonadZip(mzipWith))
+#endif
 import Data.Foldable (Foldable(foldMap))
 import Data.Functor.Classes
 import Data.Monoid (mappend)
@@ -87,3 +90,8 @@ instance (MonadFix f, MonadFix g) => MonadFix (Product f g) where
       where
         fstP (Pair a _) = a
         sndP (Pair _ b) = b
+
+#if MIN_VERSION_base(4,4,0)
+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
index 582f05b..12933ff 100644 (file)
@@ -1,3 +1,10 @@
+{-# LANGUAGE CPP #-}
+#if __GLASGOW_HASKELL__ >= 612
+{-# LANGUAGE DeriveDataTypeable #-}
+#endif
+#if __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE DeriveGeneric #-}
+#endif
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Functor.Identity
@@ -28,12 +35,31 @@ module Data.Functor.Identity (
 
 import Control.Applicative
 import Control.Monad.Fix
+#if MIN_VERSION_base(4,4,0)
+import Control.Monad.Zip (MonadZip(mzipWith, munzip))
+#endif
 import Data.Foldable (Foldable(foldMap))
 import Data.Traversable (Traversable(traverse))
+#if __GLASGOW_HASKELL__ >= 612
+import Data.Data
+#endif
+#if __GLASGOW_HASKELL__ >= 702
+import GHC.Generics
+#endif
 
 -- | Identity functor and monad. (a non-strict monad)
 newtype Identity a = Identity { runIdentity :: a }
-    deriving (Eq, Ord)
+    deriving ( Eq, Ord
+#if __GLASGOW_HASKELL__ >= 612
+             , Data, Typeable
+#endif
+#if __GLASGOW_HASKELL__ >= 702
+             , Generic
+#endif
+#if __GLASGOW_HASKELL__ >= 706
+             , Generic1
+#endif
+             )
 
 -- These instances would be equivalent to the derived instances of the
 -- newtype if the field were removed.
@@ -68,3 +94,9 @@ instance Monad Identity where
 
 instance MonadFix Identity where
     mfix f = Identity (fix (runIdentity . f))
+
+#if MIN_VERSION_base(4,4,0)
+instance MonadZip Identity where
+    mzipWith f (Identity x) (Identity y) = Identity (f x y)
+    munzip (Identity (a, b)) = (Identity a, Identity b)
+#endif
index 49b528b..5bc6e6b 100644 (file)
@@ -46,6 +46,9 @@ library
     -- NB: using impl(ghc>=7.9) instead of fragile Cabal flags
     hs-source-dirs: oldsrc
     exposed-modules: Data.Functor.Identity
+    if impl(ghc>=7.2 && <7.5)
+      -- Prior to GHC 7.5, GHC.Generics lived in ghc-prim
+      build-depends: ghc-prim
   exposed-modules:
     Control.Applicative.Backwards
     Control.Applicative.Lift