summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorFumiaki Kinoshita <fumiexcel@gmail.com>2019-04-04 15:56:40 +0900
committerMarge Bot <ben+marge-bot@smart-cactus.org>2019-07-28 19:47:50 -0400
commitcd11f81f71e99a699a5ee8120bde9cb9d7e26d6b (patch)
treef87dd87e9775a6682d5fe78cef1bbaf1947661e8
parent26314386789e3717427bab4bcb97755535bb12d4 (diff)
downloadhaskell-cd11f81f71e99a699a5ee8120bde9cb9d7e26d6b.tar.gz
base: add Functor, Applicative, Monad, Alternative, MonadPlus, Generic and Generic1 instances to Kleisli
-rw-r--r--libraries/base/Control/Arrow.hs43
-rw-r--r--libraries/base/changelog.md3
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*