Commit 673efccb authored by Ryan Scott's avatar Ryan Scott Committed by Ben Gamari

Add more type class instances for GHC.Generics

GHC.Generics provides several representation data types that have
obvious instances of various type classes in base, along with various
other types of meta-data (such as associativity and fixity).
Specifically, instances have been added for the following type classes
(where possible):

    - Applicative
    - Data
    - Functor
    - Monad
    - MonadFix
    - MonadPlus
    - MonadZip
    - Foldable
    - Traversable
    - Enum
    - Bounded
    - Ix
    - Generic1

Thanks to ocharles for starting this!

Test Plan: Validate

Reviewers: ekmett, austin, hvr, bgamari

Reviewed By: bgamari

Subscribers: RyanGlScott, thomie

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

GHC Trac Issues: #9043
parent 6319a8cf
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TypeOperators #-}
-----------------------------------------------------------------------------
-- |
......@@ -29,6 +30,7 @@ import Data.Maybe
import Data.Monoid ( Dual(..), Sum(..), Product(..)
, First(..), Last(..), Alt(..) )
import GHC.Base ( Monad, errorWithoutStackTrace, (.) )
import GHC.Generics
import GHC.List ( head, tail )
import GHC.ST
import System.IO
......@@ -103,3 +105,19 @@ instance MonadFix Last where
instance MonadFix f => MonadFix (Alt f) where
mfix f = Alt (mfix (getAlt . f))
-- Instances for GHC.Generics
instance MonadFix Par1 where
mfix f = Par1 (fix (unPar1 . f))
instance MonadFix f => MonadFix (Rec1 f) where
mfix f = Rec1 (mfix (unRec1 . f))
instance MonadFix f => MonadFix (M1 i c f) where
mfix f = M1 (mfix (unM1. f))
instance (MonadFix f, MonadFix g) => MonadFix (f :*: g) where
mfix f = (mfix (fstP . f)) :*: (mfix (sndP . f))
where
fstP (a :*: _) = a
sndP (_ :*: b) = b
{-# LANGUAGE Safe #-}
{-# LANGUAGE TypeOperators #-}
-----------------------------------------------------------------------------
-- |
......@@ -19,6 +20,7 @@ module Control.Monad.Zip where
import Control.Monad (liftM, liftM2)
import Data.Monoid
import GHC.Generics
-- | `MonadZip` type class. Minimal definition: `mzip` or `mzipWith`
--
......@@ -75,3 +77,16 @@ instance MonadZip Last where
instance MonadZip f => MonadZip (Alt f) where
mzipWith f (Alt ma) (Alt mb) = Alt (mzipWith f ma mb)
-- Instances for GHC.Generics
instance MonadZip Par1 where
mzipWith = liftM2
instance MonadZip f => MonadZip (Rec1 f) where
mzipWith f (Rec1 fa) (Rec1 fb) = Rec1 (mzipWith f fa fb)
instance MonadZip f => MonadZip (M1 i c f) where
mzipWith f (M1 fa) (M1 fb) = M1 (mzipWith f fa fb)
instance (MonadZip f, MonadZip g) => MonadZip (f :*: g) where
mzipWith f (x1 :*: y1) (x2 :*: y2) = mzipWith f x1 x2 :*: mzipWith f y1 y2
......@@ -18,6 +18,7 @@ module Data.Bifunctor
) where
import Control.Applicative ( Const(..) )
import GHC.Generics ( K1(..) )
-- | Formally, the class 'Bifunctor' represents a bifunctor
-- from @Hask@ -> @Hask@.
......@@ -99,3 +100,6 @@ instance Bifunctor Either where
instance Bifunctor Const where
bimap f _ (Const a) = Const (f a)
instance Bifunctor (K1 i) where
bimap f _ (K1 c) = K1 (f c)
This diff is collapsed.
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TypeOperators #-}
-----------------------------------------------------------------------------
-- |
......@@ -61,6 +65,7 @@ import GHC.Arr ( Array(..), elems, numElements,
foldlElems', foldrElems',
foldl1Elems, foldr1Elems)
import GHC.Base hiding ( foldr )
import GHC.Generics
import GHC.Num ( Num(..) )
infix 4 `elem`, `notElem`
......@@ -419,6 +424,23 @@ instance Ord a => Monoid (Min a) where
| x <= y = Min m
| otherwise = Min n
-- Instances for GHC.Generics
deriving instance Foldable V1
deriving instance Foldable U1
deriving instance Foldable Par1
deriving instance Foldable f => Foldable (Rec1 f)
deriving instance Foldable (K1 i c)
deriving instance Foldable f => Foldable (M1 i c f)
deriving instance (Foldable f, Foldable g) => Foldable (f :+: g)
deriving instance (Foldable f, Foldable g) => Foldable (f :*: g)
deriving instance (Foldable f, Foldable g) => Foldable (f :.: g)
deriving instance Foldable UAddr
deriving instance Foldable UChar
deriving instance Foldable UDouble
deriving instance Foldable UFloat
deriving instance Foldable UInt
deriving instance Foldable UWord
-- | Monadic fold over the elements of a structure,
-- associating to the right, i.e. from right to left.
foldrM :: (Foldable t, Monad m) => (a -> b -> m b) -> b -> t a -> m b
......
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TypeOperators #-}
-----------------------------------------------------------------------------
-- |
......@@ -58,6 +62,7 @@ import Data.Proxy ( Proxy(..) )
import GHC.Arr
import GHC.Base ( Applicative(..), Monad(..), Monoid, Maybe(..),
($), (.), id, flip )
import GHC.Generics
import qualified GHC.List as List ( foldr )
-- | Functors representing data structures that can be traversed from
......@@ -222,6 +227,23 @@ instance Traversable Last where
instance Traversable ZipList where
traverse f (ZipList x) = ZipList <$> traverse f x
-- Instances for GHC.Generics
deriving instance Traversable V1
deriving instance Traversable U1
deriving instance Traversable Par1
deriving instance Traversable f => Traversable (Rec1 f)
deriving instance Traversable (K1 i c)
deriving instance Traversable f => Traversable (M1 i c f)
deriving instance (Traversable f, Traversable g) => Traversable (f :+: g)
deriving instance (Traversable f, Traversable g) => Traversable (f :*: g)
deriving instance (Traversable f, Traversable g) => Traversable (f :.: g)
deriving instance Traversable UAddr
deriving instance Traversable UChar
deriving instance Traversable UDouble
deriving instance Traversable UFloat
deriving instance Traversable UInt
deriving instance Traversable UWord
-- general functions
-- | 'for' is 'traverse' with its arguments flipped. For a version
......
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
......@@ -700,16 +701,19 @@ module GHC.Generics (
) where
-- We use some base types
import Data.Either ( Either (..) )
import Data.Maybe ( Maybe(..), fromMaybe )
import GHC.Integer ( Integer, integerToInt )
import GHC.Prim ( Addr#, Char#, Double#, Float#, Int#, Word# )
import GHC.Ptr ( Ptr )
import GHC.Prim ( Addr#, Char#, Double#, Float#, Int#, Word# )
import GHC.Ptr ( Ptr )
import GHC.Types
import Data.Maybe ( Maybe(..), fromMaybe )
import Data.Either ( Either(..) )
-- Needed for instances
import GHC.Base ( String )
import GHC.Arr ( Ix )
import GHC.Base ( Alternative(..), Applicative(..), Functor(..)
, Monad(..), MonadPlus(..), String )
import GHC.Classes ( Eq, Ord )
import GHC.Enum ( Bounded, Enum )
import GHC.Read ( Read )
import GHC.Show ( Show )
......@@ -723,41 +727,115 @@ import GHC.TypeLits ( Nat, Symbol, KnownSymbol, KnownNat, symbolVal, natVal )
-- | Void: used for datatypes without constructors
data V1 (p :: *)
deriving (Functor, Generic, Generic1)
deriving instance Eq (V1 p)
deriving instance Ord (V1 p)
deriving instance Read (V1 p)
deriving instance Show (V1 p)
-- | Unit: used for constructors without arguments
data U1 (p :: *) = U1
deriving (Eq, Ord, Read, Show, Generic)
deriving (Eq, Ord, Read, Show, Functor, Generic, Generic1)
instance Applicative U1 where
pure _ = U1
U1 <*> U1 = U1
instance Alternative U1 where
empty = U1
U1 <|> U1 = U1
instance Monad U1 where
U1 >>= _ = U1
-- | Used for marking occurrences of the parameter
newtype Par1 p = Par1 { unPar1 :: p }
deriving (Eq, Ord, Read, Show, Generic)
deriving (Eq, Ord, Read, Show, Functor, Generic, Generic1)
instance Applicative Par1 where
pure a = Par1 a
Par1 f <*> Par1 x = Par1 (f x)
instance Monad Par1 where
Par1 x >>= f = f x
-- | Recursive calls of kind * -> *
newtype Rec1 f (p :: *) = Rec1 { unRec1 :: f p }
deriving (Eq, Ord, Read, Show, Generic)
deriving (Eq, Ord, Read, Show, Functor, Generic, Generic1)
instance Applicative f => Applicative (Rec1 f) where
pure a = Rec1 (pure a)
Rec1 f <*> Rec1 x = Rec1 (f <*> x)
instance Alternative f => Alternative (Rec1 f) where
empty = Rec1 empty
Rec1 l <|> Rec1 r = Rec1 (l <|> r)
instance Monad f => Monad (Rec1 f) where
Rec1 x >>= f = Rec1 (x >>= \a -> unRec1 (f a))
instance MonadPlus f => MonadPlus (Rec1 f)
-- | Constants, additional parameters and recursion of kind *
newtype K1 (i :: *) c (p :: *) = K1 { unK1 :: c }
deriving (Eq, Ord, Read, Show, Generic)
deriving (Eq, Ord, Read, Show, Functor, Generic, Generic1)
instance Applicative f => Applicative (M1 i c f) where
pure a = M1 (pure a)
M1 f <*> M1 x = M1 (f <*> x)
instance Alternative f => Alternative (M1 i c f) where
empty = M1 empty
M1 l <|> M1 r = M1 (l <|> r)
instance Monad f => Monad (M1 i c f) where
M1 x >>= f = M1 (x >>= \a -> unM1 (f a))
instance MonadPlus f => MonadPlus (M1 i c f)
-- | Meta-information (constructor names, etc.)
newtype M1 (i :: *) (c :: Meta) f (p :: *) = M1 { unM1 :: f p }
deriving (Eq, Ord, Read, Show, Generic)
deriving (Eq, Ord, Read, Show, Functor, Generic, Generic1)
-- | Sums: encode choice between constructors
infixr 5 :+:
data (:+:) f g (p :: *) = L1 (f p) | R1 (g p)
deriving (Eq, Ord, Read, Show, Generic)
deriving (Eq, Ord, Read, Show, Functor, Generic, Generic1)
-- | Products: encode multiple arguments to constructors
infixr 6 :*:
data (:*:) f g (p :: *) = f p :*: g p
deriving (Eq, Ord, Read, Show, Generic)
deriving (Eq, Ord, Read, Show, Functor, Generic, Generic1)
instance (Applicative f, Applicative g) => Applicative (f :*: g) where
pure a = pure a :*: pure a
(f :*: g) <*> (x :*: y) = (f <*> x) :*: (g <*> y)
instance (Alternative f, Alternative g) => Alternative (f :*: g) where
empty = empty :*: empty
(x1 :*: y1) <|> (x2 :*: y2) = (x1 <|> x2) :*: (y1 <|> y2)
instance (Monad f, Monad g) => Monad (f :*: g) where
(m :*: n) >>= f = (m >>= \a -> fstP (f a)) :*: (n >>= \a -> sndP (f a))
where
fstP (a :*: _) = a
sndP (_ :*: b) = b
instance (MonadPlus f, MonadPlus g) => MonadPlus (f :*: g)
-- | Composition of functors
infixr 7 :.:
newtype (:.:) f (g :: * -> *) (p :: *) = Comp1 { unComp1 :: f (g p) }
deriving (Eq, Ord, Read, Show, Generic)
deriving (Eq, Ord, Read, Show, Functor, Generic, Generic1)
instance (Applicative f, Applicative g) => Applicative (f :.: g) where
pure x = Comp1 (pure (pure x))
Comp1 f <*> Comp1 x = Comp1 (fmap (<*>) f <*> x)
instance (Alternative f, Applicative g) => Alternative (f :.: g) where
empty = Comp1 empty
Comp1 x <|> Comp1 y = Comp1 (x <|> y)
-- | Constants of kind @#@
--
......@@ -768,37 +846,37 @@ data family URec (a :: *) (p :: *)
--
-- @since 4.9.0.0
data instance URec (Ptr ()) p = UAddr { uAddr# :: Addr# }
deriving (Eq, Ord, Generic)
deriving (Eq, Ord, Functor, Generic, Generic1)
-- | Used for marking occurrences of 'Char#'
--
-- @since 4.9.0.0
data instance URec Char p = UChar { uChar# :: Char# }
deriving (Eq, Ord, Show, Generic)
deriving (Eq, Ord, Show, Functor, Generic, Generic1)
-- | Used for marking occurrences of 'Double#'
--
-- @since 4.9.0.0
data instance URec Double p = UDouble { uDouble# :: Double# }
deriving (Eq, Ord, Show, Generic)
deriving (Eq, Ord, Show, Functor, Generic, Generic1)
-- | Used for marking occurrences of 'Float#'
--
-- @since 4.9.0.0
data instance URec Float p = UFloat { uFloat# :: Float# }
deriving (Eq, Ord, Show, Generic)
deriving (Eq, Ord, Show, Functor, Generic, Generic1)
-- | Used for marking occurrences of 'Int#'
--
-- @since 4.9.0.0
data instance URec Int p = UInt { uInt# :: Int# }
deriving (Eq, Ord, Show, Generic)
deriving (Eq, Ord, Show, Functor, Generic, Generic1)
-- | Used for marking occurrences of 'Word#'
--
-- @since 4.9.0.0
data instance URec Word p = UWord { uWord# :: Word# }
deriving (Eq, Ord, Show, Generic)
deriving (Eq, Ord, Show, Functor, Generic, Generic1)
-- | Type synonym for 'URec': 'Addr#'
--
......@@ -908,7 +986,7 @@ prec (Infix _ n) = n
data Associativity = LeftAssociative
| RightAssociative
| NotAssociative
deriving (Eq, Show, Ord, Read, Generic)
deriving (Eq, Show, Ord, Read, Enum, Bounded, Ix, Generic)
-- | The unpackedness of a field as the user wrote it in the source code. For
-- example, in the following data type:
......@@ -926,7 +1004,7 @@ data Associativity = LeftAssociative
data SourceUnpackedness = NoSourceUnpackedness
| SourceNoUnpack
| SourceUnpack
deriving (Eq, Show, Ord, Read, Generic)
deriving (Eq, Show, Ord, Read, Enum, Bounded, Ix, Generic)
-- | The strictness of a field as the user wrote it in the source code. For
-- example, in the following data type:
......@@ -942,7 +1020,7 @@ data SourceUnpackedness = NoSourceUnpackedness
data SourceStrictness = NoSourceStrictness
| SourceLazy
| SourceStrict
deriving (Eq, Show, Ord, Read, Generic)
deriving (Eq, Show, Ord, Read, Enum, Bounded, Ix, Generic)
-- | The strictness that GHC infers for a field during compilation. Whereas
-- there are nine different combinations of 'SourceUnpackedness' and
......@@ -969,7 +1047,7 @@ data SourceStrictness = NoSourceStrictness
data DecidedStrictness = DecidedLazy
| DecidedStrict
| DecidedUnpack
deriving (Eq, Show, Ord, Read, Generic)
deriving (Eq, Show, Ord, Read, Enum, Bounded, Ix, Generic)
-- | Class for datatypes that represent records
class Selector s where
......
......@@ -104,6 +104,11 @@
* `Alt`, `Dual`, `First`, `Last`, `Product`, and `Sum` now have `Data`,
`MonadZip`, and `MonadFix` instances
* The datatypes in `GHC.Generics` now have `Enum`, `Bounded`, `Ix`,
`Functor`, `Applicative`, `Monad`, `MonadFix`, `MonadPlus`, `MonadZip`,
`Foldable`, `Foldable`, `Traversable`, `Generic1`, and `Data` instances
as appropriate.
* `Maybe` now has a `MonadZip` instance
* `All` and `Any` now have `Data` instances
......
......@@ -10,7 +10,7 @@ annfail10.hs:9:1: error:
instance Data.Data.Data Ordering -- Defined in ‘Data.Data’
instance Data.Data.Data Integer -- Defined in ‘Data.Data’
...plus 15 others
...plus 24 instances involving out-of-scope types
...plus 38 instances involving out-of-scope types
(use -fprint-potential-instances to see them all)
• In the annotation: {-# ANN f 1 #-}
......
......@@ -10,7 +10,7 @@
instance Show Ordering -- Defined in ‘GHC.Show’
instance Show Integer -- Defined in ‘GHC.Show’
...plus 23 others
...plus 21 instances involving out-of-scope types
...plus 42 instances involving out-of-scope types
(use -fprint-potential-instances to see them all)
• In a stmt of an interactive GHCi command: print it
......@@ -25,6 +25,6 @@
instance Show Ordering -- Defined in ‘GHC.Show’
instance Show Integer -- Defined in ‘GHC.Show’
...plus 23 others
...plus 21 instances involving out-of-scope types
...plus 42 instances involving out-of-scope types
(use -fprint-potential-instances to see them all)
• In a stmt of an interactive GHCi command: print it
......@@ -11,7 +11,7 @@ T10971b.hs:4:11: error:
instance Foldable Maybe -- Defined in ‘Data.Foldable’
instance Foldable ((,) a) -- Defined in ‘Data.Foldable’
...plus one other
...plus 9 instances involving out-of-scope types
...plus 24 instances involving out-of-scope types
(use -fprint-potential-instances to see them all)
• In the expression: length x
In the expression: \ x -> length x
......@@ -29,7 +29,7 @@ T10971b.hs:5:13: error:
instance Traversable Maybe -- Defined in ‘Data.Traversable’
instance Traversable ((,) a) -- Defined in ‘Data.Traversable’
...plus one other
...plus 9 instances involving out-of-scope types
...plus 24 instances involving out-of-scope types
(use -fprint-potential-instances to see them all)
• In the expression: fmapDefault f x
In the expression: \ f x -> fmapDefault f x
......@@ -47,7 +47,7 @@ T10971b.hs:6:14: error:
instance Traversable Maybe -- Defined in ‘Data.Traversable’
instance Traversable ((,) a) -- Defined in ‘Data.Traversable’
...plus one other
...plus 9 instances involving out-of-scope types
...plus 24 instances involving out-of-scope types
(use -fprint-potential-instances to see them all)
• In the expression: fmapDefault f x
In the expression: (fmapDefault f x, length x)
......@@ -65,7 +65,7 @@ T10971b.hs:6:31: error:
instance Foldable Maybe -- Defined in ‘Data.Foldable’
instance Foldable ((,) a) -- Defined in ‘Data.Foldable’
...plus one other
...plus 9 instances involving out-of-scope types
...plus 24 instances involving out-of-scope types
(use -fprint-potential-instances to see them all)
• In the expression: length x
In the expression: (fmapDefault f x, length x)
......
......@@ -7,7 +7,7 @@ T5095.hs:9:9: error:
-- Defined in ‘Data.Either’
instance Eq Ordering -- Defined in ‘GHC.Classes’
...plus 24 others
...plus 14 instances involving out-of-scope types
...plus 36 instances involving out-of-scope types
(use -fprint-potential-instances to see them all)
(The choice depends on the instantiation of ‘a’
To pick the first instance above, use IncoherentInstances
......
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