From de19721ef5d3dc64d50a1571c45d933e7f17305a Mon Sep 17 00:00:00 2001
From: Daniel Goertzen <daniel.goertzen@gmail.com>
Date: Fri, 31 Jul 2020 00:15:44 -0500
Subject: [PATCH] add Applicative methods (#372)

* add Applicative methods

- add Applicative `liftA2`, `(<*)`, and `(*>)`
- resolves https://github.com/polysemy-research/polysemy/issues/368

* remove redundant Monad return definition

- As directed in review of https://github.com/polysemy-research/polysemy/pull/372
---
 src/Polysemy/Internal.hs | 13 ++++++++++---
 1 file changed, 10 insertions(+), 3 deletions(-)

diff --git a/src/Polysemy/Internal.hs b/src/Polysemy/Internal.hs
index 856d55e..b5a1d21 100644
--- a/src/Polysemy/Internal.hs
+++ b/src/Polysemy/Internal.hs
@@ -271,11 +271,18 @@ instance Applicative (Sem f) where
   Sem f <*> Sem a = Sem $ \k -> f k <*> a k
   {-# INLINE (<*>) #-}
 
+  liftA2 f ma mb = Sem $ \k -> liftA2 f (runSem ma k) (runSem mb k)
+  {-# INLINE liftA2 #-}
+
+  ma <* mb = Sem $ \k -> runSem ma k <* runSem mb k
+  {-# INLINE (<*) #-}
+
+  -- Use (>>=) because many monads are bad at optimizing (*>).
+  -- Ref https://github.com/polysemy-research/polysemy/issues/368
+  ma *> mb = Sem $ \k -> runSem ma k >>= \_ -> runSem mb k
+  {-# INLINE (*>) #-}
 
 instance Monad (Sem f) where
-  return = pure
-  {-# INLINE return #-}
-
   Sem ma >>= f = Sem $ \k -> do
     z <- ma k
     runSem (f z) k