Define custom (*>) for various transformers to fix space leaks (fixes #33)
authorRoss Paterson <ross@soi.city.ac.uk>
Wed, 4 Oct 2017 15:50:40 +0000 (15:50 +0000)
committerRoss Paterson <ross@soi.city.ac.uk>
Wed, 4 Oct 2017 15:50:40 +0000 (15:50 +0000)
from Andrzej Rybczak

Control/Monad/Trans/Cont.hs
Control/Monad/Trans/Except.hs
Control/Monad/Trans/Identity.hs
Control/Monad/Trans/Maybe.hs
Control/Monad/Trans/Select.hs

index 9f5af41..ce2005d 100644 (file)
@@ -170,6 +170,8 @@ instance Applicative (ContT r m) where
     {-# INLINE pure #-}
     f <*> v = ContT $ \ c -> runContT f $ \ g -> runContT v (c . g)
     {-# INLINE (<*>) #-}
+    m *> k = m >>= \_ -> k
+    {-# INLINE (*>) #-}
 
 instance Monad (ContT r m) where
 #if !(MIN_VERSION_base(4,8,0))
index daa43cc..6a06297 100644 (file)
@@ -193,6 +193,8 @@ instance (Functor m, Monad m) => Applicative (ExceptT e m) where
                     Left e -> return (Left e)
                     Right x -> return (Right (k x))
     {-# INLINEABLE (<*>) #-}
+    m *> k = m >>= \_ -> k
+    {-# INLINE (*>) #-}
 
 instance (Functor m, Monad m, Monoid e) => Alternative (ExceptT e m) where
     empty = ExceptT $ return (Left mempty)
index 878a6ef..b04428e 100644 (file)
@@ -103,6 +103,10 @@ instance (Applicative m) => Applicative (IdentityT m) where
     {-# INLINE pure #-}
     (<*>) = lift2IdentityT (<*>)
     {-# INLINE (<*>) #-}
+    (*>) = lift2IdentityT (*>)
+    {-# INLINE (*>) #-}
+    (<*) = lift2IdentityT (<*)
+    {-# INLINE (<*) #-}
 
 instance (Alternative m) => Alternative (IdentityT m) where
     empty = IdentityT empty
index 245e110..13114b1 100644 (file)
@@ -140,6 +140,8 @@ instance (Functor m, Monad m) => Applicative (MaybeT m) where
                     Nothing -> return Nothing
                     Just x  -> return (Just (f x))
     {-# INLINE (<*>) #-}
+    m *> k = m >>= \_ -> k
+    {-# INLINE (*>) #-}
 
 instance (Functor m, Monad m) => Alternative (MaybeT m) where
     empty = MaybeT (return Nothing)
index a47f965..22fdf8f 100644 (file)
@@ -110,6 +110,8 @@ instance (Functor m, Monad m) => Applicative (SelectT r m) where
         f <- gf ((>>= k) . h)
         h f
     {-# INLINE (<*>) #-}
+    m *> k = m >>= \_ -> k
+    {-# INLINE (*>) #-}
 
 instance (Functor m, MonadPlus m) => Alternative (SelectT r m) where
     empty = mzero