Commit 1a9abe7a authored by Austin Seipp's avatar Austin Seipp
Browse files

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: default avatarAustin Seipp <austin@well-typed.com>
parent f932b799
{-# 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)
......
{-# 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
......
......@@ -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 #-}
......
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