[commit: packages/base] ghc-7.8: Add some instances for Monoid/Applicative (#8797) (0a1007a)
git at git.haskell.org
git at git.haskell.org
Fri Feb 28 23:39:37 UTC 2014
Repository : ssh://git@git.haskell.org/base
On branch : ghc-7.8
Link : http://ghc.haskell.org/trac/ghc/changeset/0a1007a916fc3977ef7997ca4ea72bdbabae4973/base
>---------------------------------------------------------------
commit 0a1007a916fc3977ef7997ca4ea72bdbabae4973
Author: Austin Seipp <austin at well-typed.com>
Date: Fri Feb 28 14:53:40 2014 -0600
Add some instances for Monoid/Applicative (#8797)
As noted in the ticket, there's no particular reason why there aren't
Generic, Typeable, and Data instances for the types in the
Monoid/Applicative modules.
Furthermore, Product and Sum should also have Num instances as well as
Edward noted.
Aside from that, this patch also changes the dependency chain slightly -
it moves the Monoid Proxy instance into Data.Monoid and out of
Data.Proxy.
Why? Cycles (of course). Monoid depends on Typeable. Typeable uses
Proxy. Proxy uses Monoid. Boom. Luckily, Proxy only depends on Monoid
outside of the GHC namespace, so the fix is easy and clean.
Signed-off-by: Austin Seipp <austin at well-typed.com>
(cherry picked from commit 1a9abe7a1a3c77a028cf23640368cb45527d5834)
>---------------------------------------------------------------
0a1007a916fc3977ef7997ca4ea72bdbabae4973
Control/Applicative.hs | 9 ++++++++-
Data/Monoid.hs | 25 ++++++++++++++++++-------
Data/Proxy.hs | 10 ----------
3 files changed, 26 insertions(+), 18 deletions(-)
diff --git a/Control/Applicative.hs b/Control/Applicative.hs
index 8f72521..4e77479 100644
--- a/Control/Applicative.hs
+++ b/Control/Applicative.hs
@@ -1,4 +1,6 @@
{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE AutoDeriveTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
-----------------------------------------------------------------------------
-- |
@@ -59,6 +61,7 @@ import Text.ParserCombinators.ReadP (ReadP)
import Text.ParserCombinators.ReadPrec (ReadPrec)
import GHC.Conc (STM, retry, orElse)
+import GHC.Generics
infixl 3 <|>
infixl 4 <*>, <*, *>, <**>
@@ -231,6 +234,7 @@ instance ArrowPlus a => Alternative (ArrowMonad a) where
-- new instances
newtype Const a b = Const { getConst :: a }
+ deriving (Generic, Generic1)
instance Functor (Const m) where
fmap _ (Const v) = Const v
@@ -245,6 +249,7 @@ instance Monoid m => Applicative (Const m) where
Const f <*> Const v = Const (f `mappend` v)
newtype WrappedMonad m a = WrapMonad { unwrapMonad :: m a }
+ deriving (Generic, Generic1)
instance Monad m => Functor (WrappedMonad m) where
fmap f (WrapMonad v) = WrapMonad (liftM f v)
@@ -263,6 +268,7 @@ instance MonadPlus m => Alternative (WrappedMonad m) where
WrapMonad u <|> WrapMonad v = WrapMonad (u `mplus` v)
newtype WrappedArrow a b c = WrapArrow { unwrapArrow :: a b c }
+ deriving (Generic, Generic1)
instance Arrow a => Functor (WrappedArrow a b) where
fmap f (WrapArrow a) = WrapArrow (a >>> arr f)
@@ -279,7 +285,8 @@ instance (ArrowZero a, ArrowPlus a) => Alternative (WrappedArrow a b) where
--
-- @f '<$>' 'ZipList' xs1 '<*>' ... '<*>' 'ZipList' xsn = 'ZipList' (zipWithn f xs1 ... xsn)@
--
-newtype ZipList a = ZipList { getZipList :: [a] } deriving (Show, Eq, Ord, Read)
+newtype ZipList a = ZipList { getZipList :: [a] }
+ deriving (Show, Eq, Ord, Read, Generic, Generic1)
instance Functor ZipList where
fmap f (ZipList xs) = ZipList (map f xs)
diff --git a/Data/Monoid.hs b/Data/Monoid.hs
index a7059e6..b71176b 100644
--- a/Data/Monoid.hs
+++ b/Data/Monoid.hs
@@ -1,5 +1,8 @@
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE AutoDeriveTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-----------------------------------------------------------------------------
-- |
@@ -41,7 +44,9 @@ import GHC.Enum
import GHC.Num
import GHC.Read
import GHC.Show
+import GHC.Generics
import Data.Maybe
+import Data.Proxy
{-
-- just for testing
@@ -140,9 +145,14 @@ instance Monoid Ordering where
EQ `mappend` y = y
GT `mappend` _ = GT
+instance Monoid (Proxy s) where
+ mempty = Proxy
+ mappend _ _ = Proxy
+ mconcat _ = Proxy
+
-- | The dual of a monoid, obtained by swapping the arguments of 'mappend'.
newtype Dual a = Dual { getDual :: a }
- deriving (Eq, Ord, Read, Show, Bounded)
+ deriving (Eq, Ord, Read, Show, Bounded, Generic, Generic1)
instance Monoid a => Monoid (Dual a) where
mempty = Dual mempty
@@ -150,6 +160,7 @@ instance Monoid a => Monoid (Dual a) where
-- | The monoid of endomorphisms under composition.
newtype Endo a = Endo { appEndo :: a -> a }
+ deriving (Generic)
instance Monoid (Endo a) where
mempty = Endo id
@@ -157,7 +168,7 @@ instance Monoid (Endo a) where
-- | Boolean monoid under conjunction.
newtype All = All { getAll :: Bool }
- deriving (Eq, Ord, Read, Show, Bounded)
+ deriving (Eq, Ord, Read, Show, Bounded, Generic)
instance Monoid All where
mempty = All True
@@ -165,7 +176,7 @@ instance Monoid All where
-- | Boolean monoid under disjunction.
newtype Any = Any { getAny :: Bool }
- deriving (Eq, Ord, Read, Show, Bounded)
+ deriving (Eq, Ord, Read, Show, Bounded, Generic)
instance Monoid Any where
mempty = Any False
@@ -173,7 +184,7 @@ instance Monoid Any where
-- | Monoid under addition.
newtype Sum a = Sum { getSum :: a }
- deriving (Eq, Ord, Read, Show, Bounded)
+ deriving (Eq, Ord, Read, Show, Bounded, Generic, Generic1, Num)
instance Num a => Monoid (Sum a) where
mempty = Sum 0
@@ -181,7 +192,7 @@ instance Num a => Monoid (Sum a) where
-- | Monoid under multiplication.
newtype Product a = Product { getProduct :: a }
- deriving (Eq, Ord, Read, Show, Bounded)
+ deriving (Eq, Ord, Read, Show, Bounded, Generic, Generic1, Num)
instance Num a => Monoid (Product a) where
mempty = Product 1
@@ -233,7 +244,7 @@ instance Monoid a => Monoid (Maybe a) where
-- | Maybe monoid returning the leftmost non-Nothing value.
newtype First a = First { getFirst :: Maybe a }
- deriving (Eq, Ord, Read, Show)
+ deriving (Eq, Ord, Read, Show, Generic, Generic1)
instance Monoid (First a) where
mempty = First Nothing
@@ -242,7 +253,7 @@ instance Monoid (First a) where
-- | Maybe monoid returning the rightmost non-Nothing value.
newtype Last a = Last { getLast :: Maybe a }
- deriving (Eq, Ord, Read, Show)
+ deriving (Eq, Ord, Read, Show, Generic, Generic1)
instance Monoid (Last a) where
mempty = Last Nothing
diff --git a/Data/Proxy.hs b/Data/Proxy.hs
index 4c2c5df..ab89066 100644
--- a/Data/Proxy.hs
+++ b/Data/Proxy.hs
@@ -21,8 +21,6 @@ module Data.Proxy
, KProxy(..)
) where
-import Data.Monoid
-
import GHC.Base
import GHC.Show
import GHC.Read
@@ -75,14 +73,6 @@ instance Functor Proxy where
fmap _ _ = Proxy
{-# INLINE fmap #-}
-instance Monoid (Proxy s) where
- mempty = Proxy
- {-# INLINE mempty #-}
- mappend _ _ = Proxy
- {-# INLINE mappend #-}
- mconcat _ = Proxy
- {-# INLINE mconcat #-}
-
instance Monad Proxy where
return _ = Proxy
{-# INLINE return #-}
More information about the ghc-commits
mailing list