diff options
author | Fumiaki Kinoshita <fumiexcel@gmail.com> | 2019-04-04 15:56:40 +0900 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2019-07-28 19:47:50 -0400 |
commit | cd11f81f71e99a699a5ee8120bde9cb9d7e26d6b (patch) | |
tree | f87dd87e9775a6682d5fe78cef1bbaf1947661e8 | |
parent | 26314386789e3717427bab4bcb97755535bb12d4 (diff) | |
download | haskell-cd11f81f71e99a699a5ee8120bde9cb9d7e26d6b.tar.gz |
base: add Functor, Applicative, Monad, Alternative, MonadPlus, Generic and Generic1 instances to Kleisli
-rw-r--r-- | libraries/base/Control/Arrow.hs | 43 | ||||
-rw-r--r-- | libraries/base/changelog.md | 3 |
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* |