Add various instances to newtypes in Data.Monoid
authorOleg Grenrus <oleg.grenrus@iki.fi>
Tue, 3 Mar 2015 13:21:43 +0000 (07:21 -0600)
committerAustin Seipp <austin@well-typed.com>
Tue, 3 Mar 2015 13:21:44 +0000 (07:21 -0600)
Summary:
Add Functor instances for Dual, Sum and Product
Add Foldable instances for Dual, Sum and Product
Add Traversable instances for Dual, Sum and Product
Add Foldable and Traversable instances for First and Last
Add Applicative, Monad instances to Dual, Sum, Product
Add MonadFix to Data.Monoid wrappers
Derive Data for Identity
Add Data instances to Data.Monoid wrappers
Add Data (Alt f a) instance

Reviewers: ekmett, dfeuer, hvr, austin

Reviewed By: dfeuer, austin

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D673

GHC Trac Issues: #10107

libraries/base/Control/Monad/Fix.hs
libraries/base/Data/Data.hs
libraries/base/Data/Foldable.hs
libraries/base/Data/Monoid.hs
libraries/base/Data/Traversable.hs
testsuite/tests/annotations/should_fail/annfail10.stderr
testsuite/tests/ghci.debugger/scripts/break006.stderr
testsuite/tests/typecheck/should_fail/T5095.stderr

index 76faeaf..ef8eeee 100644 (file)
@@ -26,6 +26,7 @@ module Control.Monad.Fix (
 import Data.Either
 import Data.Function ( fix )
 import Data.Maybe
+import Data.Monoid ( Dual(..), Sum(..), Product(..), First(..), Last(..) )
 import GHC.Base ( Monad, error, (.) )
 import GHC.List ( head, tail )
 import GHC.ST
@@ -81,3 +82,20 @@ instance MonadFix (Either e) where
 
 instance MonadFix (ST s) where
         mfix = fixST
+
+-- Instances of Data.Monoid wrappers
+
+instance MonadFix Dual where
+    mfix f   = Dual (fix (getDual . f))
+
+instance MonadFix Sum where
+    mfix f   = Sum (fix (getSum . f))
+
+instance MonadFix Product where
+    mfix f   = Product (fix (getProduct . f))
+
+instance MonadFix First where
+    mfix f   = First (mfix (getFirst . f))
+
+instance MonadFix Last where
+    mfix f   = Last (mfix (getLast . f))
index 6961b25..34c2350 100644 (file)
@@ -1,6 +1,7 @@
 {-# LANGUAGE Trustworthy #-}
 {-# LANGUAGE RankNTypes, ScopedTypeVariables, PolyKinds, StandaloneDeriving,
              AutoDeriveTypeable, TypeOperators, GADTs, FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 
 -----------------------------------------------------------------------------
@@ -109,10 +110,11 @@ module Data.Data (
 import Data.Either
 import Data.Eq
 import Data.Maybe
+import Data.Monoid
 import Data.Ord
 import Data.Typeable
 import Data.Version( Version(..) )
-import GHC.Base
+import GHC.Base hiding (Any)
 import GHC.List
 import GHC.Num
 import GHC.Read
@@ -1398,3 +1400,112 @@ instance Data Version where
                     1 -> k (k (z Version))
                     _ -> error "Data.Data.gunfold(Version)"
   dataTypeOf _  = versionDataType
+
+-----------------------------------------------------------------------
+-- instances for Data.Monoid wrappers
+
+dualConstr :: Constr
+dualConstr = mkConstr dualDataType "Dual" ["getDual"] Prefix
+
+dualDataType :: DataType
+dualDataType = mkDataType "Data.Monoid.Dual" [dualConstr]
+
+instance Data a => Data (Dual a) where
+  gfoldl f z (Dual x) = z Dual `f` x
+  gunfold k z _ = k (z Dual)
+  toConstr (Dual _) = dualConstr
+  dataTypeOf _ = dualDataType
+  dataCast1 f = gcast1 f
+
+allConstr :: Constr
+allConstr = mkConstr allDataType "All" ["getAll"] Prefix
+
+allDataType :: DataType
+allDataType = mkDataType "All" [allConstr]
+
+instance Data All where
+  gfoldl f z (All x) = (z All `f` x)
+  gunfold k z _ = k (z All)
+  toConstr (All _) = allConstr
+  dataTypeOf _ = allDataType
+
+anyConstr :: Constr
+anyConstr = mkConstr anyDataType "Any" ["getAny"] Prefix
+
+anyDataType :: DataType
+anyDataType = mkDataType "Any" [anyConstr]
+
+instance Data Any where
+  gfoldl f z (Any x) = (z Any `f` x)
+  gunfold k z _ = k (z Any)
+  toConstr (Any _) = anyConstr
+  dataTypeOf _ = anyDataType
+
+
+sumConstr :: Constr
+sumConstr = mkConstr sumDataType "Sum" ["getSum"] Prefix
+
+sumDataType :: DataType
+sumDataType = mkDataType "Data.Monoid.Sum" [sumConstr]
+
+instance Data a => Data (Sum a) where
+  gfoldl f z (Sum x) = z Sum `f` x
+  gunfold k z _ = k (z Sum)
+  toConstr (Sum _) = sumConstr
+  dataTypeOf _ = sumDataType
+  dataCast1 f = gcast1 f
+
+
+productConstr :: Constr
+productConstr = mkConstr productDataType "Product" ["getProduct"] Prefix
+
+productDataType :: DataType
+productDataType = mkDataType "Data.Monoid.Product" [productConstr]
+
+instance Data a => Data (Product a) where
+  gfoldl f z (Product x) = z Product `f` x
+  gunfold k z _ = k (z Product)
+  toConstr (Product _) = productConstr
+  dataTypeOf _ = productDataType
+  dataCast1 f = gcast1 f
+
+
+firstConstr :: Constr
+firstConstr = mkConstr firstDataType "First" ["getFirst"] Prefix
+
+firstDataType :: DataType
+firstDataType = mkDataType "Data.Monoid.First" [firstConstr]
+
+instance Data a => Data (First a) where
+  gfoldl f z (First x) = (z First `f` x)
+  gunfold k z _ = k (z First)
+  toConstr (First _) = firstConstr
+  dataTypeOf _ = firstDataType
+  dataCast1 f = gcast1 f
+
+
+lastConstr :: Constr
+lastConstr = mkConstr lastDataType "Last" ["getLast"] Prefix
+
+lastDataType :: DataType
+lastDataType = mkDataType "Data.Monoid.Last" [lastConstr]
+
+instance Data a => Data (Last a) where
+  gfoldl f z (Last x) = (z Last `f` x)
+  gunfold k z _ = k (z Last)
+  toConstr (Last _) = lastConstr
+  dataTypeOf _ = lastDataType
+  dataCast1 f = gcast1 f
+
+
+altConstr :: Constr
+altConstr = mkConstr altDataType "Alt" ["getAlt"] Prefix
+
+altDataType :: DataType
+altDataType = mkDataType "Alt" [altConstr]
+
+instance (Data (f a), Typeable f, Typeable a) => Data (Alt f a) where
+  gfoldl f z (Alt x) = (z Alt `f` x)
+  gunfold k z _ = k (z Alt)
+  toConstr (Alt _) = altConstr
+  dataTypeOf _ = altDataType
index a745f66..1f20261 100644 (file)
@@ -282,6 +282,66 @@ instance Foldable Proxy where
     sum _      = 0
     product _  = 1
 
+instance Foldable Dual where
+    foldMap            = coerce
+
+    elem               = (. getDual) #. (==)
+    foldl              = coerce
+    foldl'             = coerce
+    foldl1 _           = getDual
+    foldr f z (Dual x) = f x z
+    foldr'             = foldr
+    foldr1 _           = getDual
+    length _           = 1
+    maximum            = getDual
+    minimum            = getDual
+    null _             = False
+    product            = getDual
+    sum                = getDual
+    toList (Dual x)    = [x]
+
+instance Foldable Sum where
+    foldMap            = coerce
+
+    elem               = (. getSum) #. (==)
+    foldl              = coerce
+    foldl'             = coerce
+    foldl1 _           = getSum
+    foldr f z (Sum x)  = f x z
+    foldr'             = foldr
+    foldr1 _           = getSum
+    length _           = 1
+    maximum            = getSum
+    minimum            = getSum
+    null _             = False
+    product            = getSum
+    sum                = getSum
+    toList (Sum x)     = [x]
+
+instance Foldable Product where
+    foldMap               = coerce
+
+    elem                  = (. getProduct) #. (==)
+    foldl                 = coerce
+    foldl'                = coerce
+    foldl1 _              = getProduct
+    foldr f z (Product x) = f x z
+    foldr'                = foldr
+    foldr1 _              = getProduct
+    length _              = 1
+    maximum               = getProduct
+    minimum               = getProduct
+    null _                = False
+    product               = getProduct
+    sum                   = getProduct
+    toList (Product x)    = [x]
+
+instance Foldable First where
+    foldMap f = foldMap f . getFirst
+
+instance Foldable Last where
+    foldMap f = foldMap f . getLast
+
 -- We don't export Max and Min because, as Edward Kmett pointed out to me,
 -- there are two reasonable ways to define them. One way is to use Maybe, as we
 -- do here; the other way is to impose a Bounded constraint on the Monoid
index dbabaff..82c0160 100644 (file)
@@ -75,6 +75,17 @@ instance Monoid a => Monoid (Dual a) where
         mempty = Dual mempty
         Dual x `mappend` Dual y = Dual (y `mappend` x)
 
+instance Functor Dual where
+    fmap     = coerce
+
+instance Applicative Dual where
+    pure     = Dual
+    (<*>)    = coerce
+
+instance Monad Dual where
+    return   = Dual
+    m >>= k  = k (getDual m)
+
 -- | The monoid of endomorphisms under composition.
 newtype Endo a = Endo { appEndo :: a -> a }
                deriving (Generic)
@@ -108,6 +119,17 @@ instance Num a => Monoid (Sum a) where
         mappend = coerce ((+) :: a -> a -> a)
 --        Sum x `mappend` Sum y = Sum (x + y)
 
+instance Functor Sum where
+    fmap     = coerce
+
+instance Applicative Sum where
+    pure     = Sum
+    (<*>)    = coerce
+
+instance Monad Sum where
+    return   = Sum
+    m >>= k  = k (getSum m)
+
 -- | Monoid under multiplication.
 newtype Product a = Product { getProduct :: a }
         deriving (Eq, Ord, Read, Show, Bounded, Generic, Generic1, Num)
@@ -117,6 +139,17 @@ instance Num a => Monoid (Product a) where
         mappend = coerce ((*) :: a -> a -> a)
 --        Product x `mappend` Product y = Product (x * y)
 
+instance Functor Product where
+    fmap     = coerce
+
+instance Applicative Product where
+    pure     = Product
+    (<*>)    = coerce
+
+instance Monad Product where
+    return   = Product
+    m >>= k  = k (getProduct m)
+
 -- $MaybeExamples
 -- To implement @find@ or @findLast@ on any 'Foldable':
 --
index e7caf4e..aaea44b 100644 (file)
@@ -50,6 +50,7 @@ import Control.Applicative ( Const(..) )
 import Data.Either ( Either(..) )
 import Data.Foldable ( Foldable )
 import Data.Functor
+import Data.Monoid ( Dual(..), Sum(..), Product(..), First(..), Last(..) )
 import Data.Proxy ( Proxy(..) )
 
 import GHC.Arr
@@ -205,6 +206,21 @@ instance Traversable Proxy where
 instance Traversable (Const m) where
     traverse _ (Const m) = pure $ Const m
 
+instance Traversable Dual where
+    traverse f (Dual x) = Dual <$> f x
+
+instance Traversable Sum where
+    traverse f (Sum x) = Sum <$> f x
+
+instance Traversable Product where
+    traverse f (Product x) = Product <$> f x
+
+instance Traversable First where
+    traverse f (First x) = First <$> traverse f x
+
+instance Traversable Last where
+    traverse f (Last x) = Last <$> traverse f x
+
 -- general functions
 
 -- | 'for' is 'traverse' with its arguments flipped. For a version
index baddbbd..262677b 100644 (file)
@@ -6,21 +6,26 @@ annfail10.hs:9:1:
       instance (Data.Data.Data a, Data.Data.Data b) =>
                Data.Data.Data (Either a b)
         -- Defined in ‘Data.Data’
-      instance Data.Data.Data t => Data.Data.Data (Data.Proxy.Proxy t)
+      instance Data.Data.Data Data.Monoid.All -- Defined in ‘Data.Data’
+      instance forall (k :: BOX) (f :: k -> *) (a :: k).
+               (Data.Data.Data (f a), Data.Typeable.Internal.Typeable f,
+                Data.Typeable.Internal.Typeable a) =>
+               Data.Data.Data (Data.Monoid.Alt f a)
         -- Defined in ‘Data.Data’
-      instance (GHC.Types.Coercible a b, Data.Data.Data a,
-                Data.Data.Data b) =>
-               Data.Data.Data (Data.Type.Coercion.Coercion a b)
-        -- Defined in ‘Data.Data’
-      ...plus 31 others
+      ...plus 39 others
     In the annotation: {-# ANN f 1 #-}
 
 annfail10.hs:9:11:
     No instance for (Num a0) arising from the literal ‘1’
     The type variable ‘a0’ is ambiguous
     Note: there are several potential instances:
-      instance Num GHC.Int.Int16 -- Defined in ‘GHC.Int’
-      instance Num GHC.Int.Int32 -- Defined in ‘GHC.Int’
-      instance Num GHC.Int.Int64 -- Defined in ‘GHC.Int’
-      ...plus 11 others
+      instance forall (k :: BOX) (f :: k -> *) (a :: k).
+               Num (f a) =>
+               Num (Data.Monoid.Alt f a)
+        -- Defined in ‘Data.Monoid’
+      instance Num a => Num (Data.Monoid.Product a)
+        -- Defined in ‘Data.Monoid’
+      instance Num a => Num (Data.Monoid.Sum a)
+        -- Defined in ‘Data.Monoid’
+      ...plus 14 others
     In the annotation: {-# ANN f 1 #-}
index 5084150..8658605 100644 (file)
@@ -7,11 +7,12 @@
     Note: there are several potential instances:
       instance (Show a, Show b) => Show (Either a b)
         -- Defined in ‘Data.Either’
-      instance forall (k :: BOX) (s :: k). Show (Data.Proxy.Proxy s)
-        -- Defined in ‘Data.Proxy’
-      instance (GHC.Arr.Ix a, Show a, Show b) => Show (GHC.Arr.Array a b)
-        -- Defined in ‘GHC.Arr’
-      ...plus 25 others
+      instance Show Data.Monoid.All -- Defined in ‘Data.Monoid’
+      instance forall (k :: BOX) (f :: k -> *) (a :: k).
+               Show (f a) =>
+               Show (Data.Monoid.Alt f a)
+        -- Defined in ‘Data.Monoid’
+      ...plus 33 others
     In a stmt of an interactive GHCi command: print it
 
 <interactive>:8:1:
     Note: there are several potential instances:
       instance (Show a, Show b) => Show (Either a b)
         -- Defined in ‘Data.Either’
-      instance forall (k :: BOX) (s :: k). Show (Data.Proxy.Proxy s)
-        -- Defined in ‘Data.Proxy’
-      instance (GHC.Arr.Ix a, Show a, Show b) => Show (GHC.Arr.Array a b)
-        -- Defined in ‘GHC.Arr’
-      ...plus 25 others
+      instance Show Data.Monoid.All -- Defined in ‘Data.Monoid’
+      instance forall (k :: BOX) (f :: k -> *) (a :: k).
+               Show (f a) =>
+               Show (Data.Monoid.Alt f a)
+        -- Defined in ‘Data.Monoid’
+      ...plus 33 others
     In a stmt of an interactive GHCi command: print it
index af420d2..e0f9336 100644 (file)
@@ -60,6 +60,21 @@ T5095.hs:9:11:
         -- Defined in ‘integer-gmp-1.0.0.0:GHC.Integer.Type’
       instance Eq Integer
         -- Defined in ‘integer-gmp-1.0.0.0:GHC.Integer.Type’
+      instance Eq Data.Monoid.All -- Defined in ‘Data.Monoid’
+      instance forall (k :: BOX) (f :: k -> *) (a :: k).
+               Eq (f a) =>
+               Eq (Data.Monoid.Alt f a)
+        -- Defined in ‘Data.Monoid’
+      instance Eq Data.Monoid.Any -- Defined in ‘Data.Monoid’
+      instance Eq a => Eq (Data.Monoid.Dual a)
+        -- Defined in ‘Data.Monoid’
+      instance Eq a => Eq (Data.Monoid.First a)
+        -- Defined in ‘Data.Monoid’
+      instance Eq a => Eq (Data.Monoid.Last a)
+        -- Defined in ‘Data.Monoid’
+      instance Eq a => Eq (Data.Monoid.Product a)
+        -- Defined in ‘Data.Monoid’
+      instance Eq a => Eq (Data.Monoid.Sum a) -- Defined in ‘Data.Monoid’
       instance forall (k :: BOX) (s :: k). Eq (Data.Proxy.Proxy s)
         -- Defined in ‘Data.Proxy’
       instance (Eq a, Eq b) => Eq (Either a b)