base: add Functor, Applicative, Monad, Alternative, MonadPlus, Generic and Generic1 instances to Kleisli

2 files changed, 46 insertions, 0 deletions

diff --git a/libraries/base/Control/Arrow.hs b/libraries/base/Control/Arrow.hs
index 13759dbbb4..eec25a3179 100644
--- a/libraries/base/Control/Arrow.hs
+++ b/libraries/base/Control/Arrow.hs
@@ -1,5 +1,8 @@
 {-# LANGUAGE Trustworthy #-}
 {-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE StandaloneDeriving #-}
 {-# OPTIONS_GHC -Wno-inline-rule-shadowing #-}
     -- The RULES for the methods of class Arrow may never fire
     -- e.g. compose/arr;  see #10528
@@ -51,6 +54,7 @@ import Data.Either
 import Control.Monad.Fix
 import Control.Category
 import GHC.Base hiding ( (.), id )
+import GHC.Generics (Generic, Generic1)
 
 infixr 5 <+>
 infixr 3 ***
@@ -149,6 +153,45 @@ instance Arrow (->) where
 -- | Kleisli arrows of a monad.
 newtype Kleisli m a b = Kleisli { runKleisli :: a -> m b }
 
+-- | @since 4.14.0.0
+deriving instance Generic (Kleisli m a b)
+
+-- | @since 4.14.0.0
+deriving instance Generic1 (Kleisli m a)
+
+-- | @since 4.14.0.0
+deriving instance Functor m => Functor (Kleisli m a)
+
+-- | @since 4.14.0.0
+instance Applicative m => Applicative (Kleisli m a) where
+  pure = Kleisli . const . pure
+  {-# INLINE pure #-}
+  Kleisli f <*> Kleisli g = Kleisli $ \x -> f x <*> g x
+  {-# INLINE (<*>) #-}
+  Kleisli f *> Kleisli g = Kleisli $ \x -> f x *> g x
+  {-# INLINE (*>) #-}
+  Kleisli f <* Kleisli g = Kleisli $ \x -> f x <* g x
+  {-# INLINE (<*) #-}
+
+-- | @since 4.14.0.0
+instance Alternative m => Alternative (Kleisli m a) where
+  empty = Kleisli $ const empty
+  {-# INLINE empty #-}
+  Kleisli f <|> Kleisli g = Kleisli $ \x -> f x <|> g x
+  {-# INLINE (<|>) #-}
+
+-- | @since 4.14.0.0
+instance Monad m => Monad (Kleisli m a) where
+  Kleisli f >>= k = Kleisli $ \x -> f x >>= \a -> runKleisli (k a) x
+  {-# INLINE (>>=) #-}
+
+-- | @since 4.14.0.0
+instance MonadPlus m => MonadPlus (Kleisli m a) where
+  mzero = Kleisli $ const mzero
+  {-# INLINE mzero #-}
+  Kleisli f `mplus` Kleisli g = Kleisli $ \x -> f x `mplus` g x
+  {-# INLINE mplus #-}
+
 -- | @since 3.0
 instance Monad m => Category (Kleisli m) where
     id = Kleisli return
diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md
index 8cb3366dd2..d5694e7a39 100644
--- a/libraries/base/changelog.md
+++ b/libraries/base/changelog.md
@@ -25,6 +25,9 @@
 
   * Add `HasResolution` instances for `Nat`s.
 
+  * Add `Functor`, `Applicative`, `Monad`, `Alternative`, `MonadPlus`,
+    `Generic` and `Generic1` instances to `Kleisli`
+
 ## 4.13.0.0 *TBA*
   * Bundled with GHC *TBA*