Commit 7782b47c authored by Xia Li-yao's avatar Xia Li-yao Committed by Ben Gamari

Add Applicative, Semigroup, and Monoid instances in GHC.Generics

Reviewers: hvr, bgamari, alpmestan, RyanGlScott

Reviewed By: RyanGlScott

Subscribers: RyanGlScott, rwbarton, thomie, carter

Differential Revision: https://phabricator.haskell.org/D4447
parent bc1bcaa2
......@@ -740,7 +740,8 @@ import GHC.Types
-- Needed for instances
import GHC.Arr ( Ix )
import GHC.Base ( Alternative(..), Applicative(..), Functor(..)
, Monad(..), MonadPlus(..), NonEmpty(..), String, coerce )
, Monad(..), MonadPlus(..), NonEmpty(..), String, coerce
, Semigroup(..), Monoid(..) )
import GHC.Classes ( Eq(..), Ord(..) )
import GHC.Enum ( Bounded, Enum )
import GHC.Read ( Read(..) )
......@@ -765,6 +766,10 @@ data V1 (p :: k)
, Generic1 -- ^ @since 4.9.0.0
)
-- | @since 4.12.0.0
instance Semigroup (V1 p) where
v <> _ = v
-- | Unit: used for constructors without arguments
data U1 (p :: k) = U1
deriving ( Generic -- ^ @since 4.7.0.0
......@@ -808,6 +813,14 @@ instance Monad U1 where
-- | @since 4.9.0.0
instance MonadPlus U1
-- | @since 4.12.0.0
instance Semigroup (U1 p) where
_ <> _ = U1
-- | @since 4.12.0.0
instance Monoid (U1 p) where
mempty = U1
-- | Used for marking occurrences of the parameter
newtype Par1 p = Par1 { unPar1 :: p }
deriving ( Eq -- ^ @since 4.7.0.0
......@@ -829,6 +842,12 @@ instance Applicative Par1 where
instance Monad Par1 where
Par1 x >>= f = f x
-- | @since 4.12.0.0
deriving instance Semigroup p => Semigroup (Par1 p)
-- | @since 4.12.0.0
deriving instance Monoid p => Monoid (Par1 p)
-- | Recursive calls of kind @* -> *@ (or kind @k -> *@, when @PolyKinds@
-- is enabled)
newtype Rec1 (f :: k -> *) (p :: k) = Rec1 { unRec1 :: f p }
......@@ -854,6 +873,12 @@ instance Monad f => Monad (Rec1 f) where
-- | @since 4.9.0.0
deriving instance MonadPlus f => MonadPlus (Rec1 f)
-- | @since 4.12.0.0
deriving instance Semigroup (f p) => Semigroup (Rec1 f p)
-- | @since 4.12.0.0
deriving instance Monoid (f p) => Monoid (Rec1 f p)
-- | Constants, additional parameters and recursion of kind @*@
newtype K1 (i :: *) c (p :: k) = K1 { unK1 :: c }
deriving ( Eq -- ^ @since 4.7.0.0
......@@ -865,6 +890,18 @@ newtype K1 (i :: *) c (p :: k) = K1 { unK1 :: c }
, Generic1 -- ^ @since 4.9.0.0
)
-- | @since 4.12.0.0
instance Monoid c => Applicative (K1 i c) where
pure _ = K1 mempty
liftA2 = \_ -> coerce (mappend :: c -> c -> c)
(<*>) = coerce (mappend :: c -> c -> c)
-- | @since 4.12.0.0
deriving instance Semigroup c => Semigroup (K1 i c p)
-- | @since 4.12.0.0
deriving instance Monoid c => Monoid (K1 i c p)
-- | @since 4.9.0.0
deriving instance Applicative f => Applicative (M1 i c f)
......@@ -877,6 +914,12 @@ deriving instance Monad f => Monad (M1 i c f)
-- | @since 4.9.0.0
deriving instance MonadPlus f => MonadPlus (M1 i c f)
-- | @since 4.12.0.0
deriving instance Semigroup (f p) => Semigroup (M1 i c f p)
-- | @since 4.12.0.0
deriving instance Monoid (f p) => Monoid (M1 i c f p)
-- | Meta-information (constructor names, etc.)
newtype M1 (i :: *) (c :: Meta) (f :: k -> *) (p :: k) = M1 { unM1 :: f p }
deriving ( Eq -- ^ @since 4.7.0.0
......@@ -933,6 +976,14 @@ instance (Monad f, Monad g) => Monad (f :*: g) where
-- | @since 4.9.0.0
instance (MonadPlus f, MonadPlus g) => MonadPlus (f :*: g)
-- | @since 4.12.0.0
instance (Semigroup (f p), Semigroup (g p)) => Semigroup ((f :*: g) p) where
(x1 :*: y1) <> (x2 :*: y2) = (x1 <> x2) :*: (y1 <> y2)
-- | @since 4.12.0.0
instance (Monoid (f p), Monoid (g p)) => Monoid ((f :*: g) p) where
mempty = mempty :*: mempty
-- | Composition of functors
infixr 7 :.:
newtype (:.:) (f :: k2 -> *) (g :: k1 -> k2) (p :: k1) =
......@@ -958,6 +1009,12 @@ instance (Alternative f, Applicative g) => Alternative (f :.: g) where
(<|>) = coerce ((<|>) :: f (g a) -> f (g a) -> f (g a)) ::
forall a . (f :.: g) a -> (f :.: g) a -> (f :.: g) a
-- | @since 4.12.0.0
deriving instance Semigroup (f (g p)) => Semigroup ((f :.: g) p)
-- | @since 4.12.0.0
deriving instance Monoid (f (g p)) => Monoid ((f :.: g) p)
-- | Constants of unlifted kinds
--
-- @since 4.9.0.0
......
......@@ -6,6 +6,9 @@
* `($!)` is now representation-polymorphic like `($)`.
* Add `Applicative` (for `K1`), `Semigroup` and `Monoid` instances in
`GHC.Generics`. (#14849)
## 4.11.0.0 *TBA*
* Bundled with GHC 8.4.1
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment