Commit 4e6bcc2c authored by Oleg Grenrus's avatar Oleg Grenrus Committed by Austin Seipp
Browse files

Add various instances to newtypes in Data.Monoid

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
parent 89458eba
......@@ -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))
{-# 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
......@@ -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
......
......@@ -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':
--
......
......@@ -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
......
......@@ -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 #-}
......@@ -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:
......@@ -22,9 +23,10 @@
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
......@@ -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)
......
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