Add more type class instances for GHC.Generics
authorRyanGlScott <ryan.gl.scott@gmail.com>
Thu, 25 Feb 2016 13:49:48 +0000 (14:49 +0100)
committerBen Gamari <ben@smart-cactus.org>
Thu, 25 Feb 2016 14:41:55 +0000 (15:41 +0100)
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

12 files changed:
libraries/base/Control/Monad/Fix.hs
libraries/base/Control/Monad/Zip.hs
libraries/base/Data/Bifunctor.hs
libraries/base/Data/Data.hs
libraries/base/Data/Foldable.hs
libraries/base/Data/Traversable.hs
libraries/base/GHC/Generics.hs
libraries/base/changelog.md
testsuite/tests/annotations/should_fail/annfail10.stderr
testsuite/tests/ghci.debugger/scripts/break006.stderr
testsuite/tests/typecheck/should_fail/T10971b.stderr
testsuite/tests/typecheck/should_fail/T5095.stderr

index 6b78e90..4862770 100644 (file)
@@ -1,5 +1,6 @@
 {-# 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
index 1f63cab..771b8aa 100644 (file)
@@ -1,4 +1,5 @@
 {-# 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
index 2412ce7..9cc3c1c 100644 (file)
@@ -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)
index cc94bac..fd189ed 100644 (file)
@@ -3,6 +3,7 @@
              TypeOperators, GADTs, FlexibleInstances #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE BangPatterns #-}
 
 -----------------------------------------------------------------------------
 -- |
@@ -133,7 +134,9 @@ import GHC.ForeignPtr        -- So we can give Data instance for ForeignPtr
 --import GHC.ST                -- So we can give Data instance for ST
 --import GHC.Conc              -- So we can give Data instance for MVar & Co.
 import GHC.Arr               -- So we can give Data instance for Array
-
+import qualified GHC.Generics as Generics (Fixity(..))
+import GHC.Generics hiding (Fixity(..))
+                             -- So we can give Data instance for U1, V1, ...
 
 ------------------------------------------------------------------------------
 --
@@ -1509,3 +1512,307 @@ instance (Data (f a), Data a, Typeable f) => Data (Alt f a) where
   gunfold k z _ = k (z Alt)
   toConstr (Alt _) = altConstr
   dataTypeOf _ = altDataType
+
+-----------------------------------------------------------------------
+-- instances for GHC.Generics
+
+u1Constr :: Constr
+u1Constr = mkConstr u1DataType "U1" [] Prefix
+
+u1DataType :: DataType
+u1DataType = mkDataType "GHC.Generics.U1" [u1Constr]
+
+instance Data p => Data (U1 p) where
+  gfoldl _ z U1 = z U1
+  toConstr U1 = u1Constr
+  gunfold _ z c = case constrIndex c of
+                    1 -> z U1
+                    _ -> errorWithoutStackTrace "Data.Data.gunfold(U1)"
+  dataTypeOf _  = u1DataType
+  dataCast1 f = gcast1 f
+
+-----------------------------------------------------------------------
+
+par1Constr :: Constr
+par1Constr = mkConstr par1DataType "Par1" [] Prefix
+
+par1DataType :: DataType
+par1DataType = mkDataType "GHC.Generics.Par1" [par1Constr]
+
+instance Data p => Data (Par1 p) where
+  gfoldl k z (Par1 p) = z Par1 `k` p
+  toConstr (Par1 _) = par1Constr
+  gunfold k z c = case constrIndex c of
+                    1 -> k (z Par1)
+                    _ -> errorWithoutStackTrace "Data.Data.gunfold(Par1)"
+  dataTypeOf _  = par1DataType
+  dataCast1 f = gcast1 f
+
+-----------------------------------------------------------------------
+
+rec1Constr :: Constr
+rec1Constr = mkConstr rec1DataType "Rec1" [] Prefix
+
+rec1DataType :: DataType
+rec1DataType = mkDataType "GHC.Generics.Rec1" [rec1Constr]
+
+instance (Data (f p), Typeable f, Data p) => Data (Rec1 f p) where
+  gfoldl k z (Rec1 p) = z Rec1 `k` p
+  toConstr (Rec1 _) = rec1Constr
+  gunfold k z c = case constrIndex c of
+                    1 -> k (z Rec1)
+                    _ -> errorWithoutStackTrace "Data.Data.gunfold(Rec1)"
+  dataTypeOf _  = rec1DataType
+  dataCast1 f = gcast1 f
+
+-----------------------------------------------------------------------
+
+k1Constr :: Constr
+k1Constr = mkConstr k1DataType "K1" [] Prefix
+
+k1DataType :: DataType
+k1DataType = mkDataType "GHC.Generics.K1" [k1Constr]
+
+instance (Typeable i, Data p, Data c) => Data (K1 i c p) where
+  gfoldl k z (K1 p) = z K1 `k` p
+  toConstr (K1 _) = k1Constr
+  gunfold k z c = case constrIndex c of
+                    1 -> k (z K1)
+                    _ -> errorWithoutStackTrace "Data.Data.gunfold(K1)"
+  dataTypeOf _  = k1DataType
+  dataCast1 f = gcast1 f
+
+-----------------------------------------------------------------------
+
+m1Constr :: Constr
+m1Constr = mkConstr m1DataType "M1" [] Prefix
+
+m1DataType :: DataType
+m1DataType = mkDataType "GHC.Generics.M1" [m1Constr]
+
+instance (Data p, Data (f p), Typeable c, Typeable i, Typeable f)
+    => Data (M1 i c f p) where
+  gfoldl k z (M1 p) = z M1 `k` p
+  toConstr (M1 _) = m1Constr
+  gunfold k z c = case constrIndex c of
+                    1 -> k (z M1)
+                    _ -> errorWithoutStackTrace "Data.Data.gunfold(M1)"
+  dataTypeOf _  = m1DataType
+  dataCast1 f = gcast1 f
+
+-----------------------------------------------------------------------
+
+sum1DataType :: DataType
+sum1DataType = mkDataType "GHC.Generics.:+:" [l1Constr, r1Constr]
+
+l1Constr :: Constr
+l1Constr = mkConstr sum1DataType "L1" [] Prefix
+
+r1Constr :: Constr
+r1Constr = mkConstr sum1DataType "R1" [] Prefix
+
+instance (Typeable f, Typeable g, Data p, Data (f p), Data (g p))
+    => Data ((f :+: g) p) where
+  gfoldl k z (L1 a) = z L1 `k` a
+  gfoldl k z (R1 a) = z R1 `k` a
+  toConstr L1{} = l1Constr
+  toConstr R1{} = r1Constr
+  gunfold k z c = case constrIndex c of
+                    1 -> k (z L1)
+                    2 -> k (z R1)
+                    _ -> errorWithoutStackTrace "Data.Data.gunfold(:+:)"
+  dataTypeOf _ = sum1DataType
+  dataCast1 f = gcast1 f
+
+-----------------------------------------------------------------------
+
+comp1Constr :: Constr
+comp1Constr = mkConstr comp1DataType "Comp1" [] Prefix
+
+comp1DataType :: DataType
+comp1DataType = mkDataType "GHC.Generics.:.:" [comp1Constr]
+
+instance (Typeable f, Typeable g, Data p, Data (f (g p)))
+    => Data ((f :.: g) p) where
+  gfoldl k z (Comp1 c) = z Comp1 `k` c
+  toConstr (Comp1 _) = m1Constr
+  gunfold k z c = case constrIndex c of
+                    1 -> k (z Comp1)
+                    _ -> errorWithoutStackTrace "Data.Data.gunfold(:.:)"
+  dataTypeOf _ = comp1DataType
+  dataCast1 f = gcast1 f
+
+-----------------------------------------------------------------------
+
+v1DataType :: DataType
+v1DataType = mkDataType "GHC.Generics.V1" []
+
+instance Data p => Data (V1 p) where
+  gfoldl _ _ !_ = undefined
+  toConstr !_ = undefined
+  gunfold _ _ _ = errorWithoutStackTrace "Data.Data.gunfold(V1)"
+  dataTypeOf _ = v1DataType
+  dataCast1 f = gcast1 f
+
+-----------------------------------------------------------------------
+
+prod1DataType :: DataType
+prod1DataType = mkDataType "GHC.Generics.:*:" [prod1Constr]
+
+prod1Constr :: Constr
+prod1Constr = mkConstr prod1DataType "Prod1" [] Infix
+
+instance (Typeable f, Typeable g, Data p, Data (f p), Data (g p))
+    => Data ((f :*: g) p) where
+  gfoldl k z (l :*: r) = z (:*:) `k` l `k` r
+  toConstr _ = prod1Constr
+  gunfold k z c = case constrIndex c of
+                    1 -> k (k (z (:*:)))
+                    _ -> errorWithoutStackTrace "Data.Data.gunfold(:*:)"
+  dataCast1 f = gcast1 f
+  dataTypeOf _ = prod1DataType
+
+-----------------------------------------------------------------------
+
+prefixConstr :: Constr
+prefixConstr = mkConstr fixityDataType "Prefix" [] Prefix
+infixConstr  :: Constr
+infixConstr  = mkConstr fixityDataType "Infix"  [] Prefix
+
+fixityDataType :: DataType
+fixityDataType = mkDataType "GHC.Generics.Fixity" [prefixConstr,infixConstr]
+
+instance Data Generics.Fixity where
+  gfoldl _ z Generics.Prefix      = z Generics.Prefix
+  gfoldl f z (Generics.Infix a i) = z Generics.Infix `f` a `f` i
+  toConstr Generics.Prefix  = prefixConstr
+  toConstr Generics.Infix{} = infixConstr
+  gunfold k z c = case constrIndex c of
+                    1 -> z Generics.Prefix
+                    2 -> k (k (z Generics.Infix))
+                    _ -> errorWithoutStackTrace "Data.Data.gunfold(Fixity)"
+  dataTypeOf _ = fixityDataType
+
+-----------------------------------------------------------------------
+
+leftAssociativeConstr :: Constr
+leftAssociativeConstr
+  = mkConstr associativityDataType "LeftAssociative" [] Prefix
+rightAssociativeConstr :: Constr
+rightAssociativeConstr
+  = mkConstr associativityDataType "RightAssociative" [] Prefix
+notAssociativeConstr :: Constr
+notAssociativeConstr
+  = mkConstr associativityDataType "NotAssociative" [] Prefix
+
+associativityDataType :: DataType
+associativityDataType = mkDataType "GHC.Generics.Associativity"
+  [leftAssociativeConstr,rightAssociativeConstr,notAssociativeConstr]
+
+instance Data Associativity where
+  gfoldl _ z LeftAssociative  = z LeftAssociative
+  gfoldl _ z RightAssociative = z RightAssociative
+  gfoldl _ z NotAssociative   = z NotAssociative
+  toConstr LeftAssociative  = leftAssociativeConstr
+  toConstr RightAssociative = rightAssociativeConstr
+  toConstr NotAssociative   = notAssociativeConstr
+  gunfold _ z c = case constrIndex c of
+                    1 -> z LeftAssociative
+                    2 -> z RightAssociative
+                    3 -> z NotAssociative
+                    _ -> errorWithoutStackTrace
+                           "Data.Data.gunfold(Associativity)"
+  dataTypeOf _ = associativityDataType
+
+-----------------------------------------------------------------------
+
+noSourceUnpackednessConstr :: Constr
+noSourceUnpackednessConstr
+  = mkConstr sourceUnpackednessDataType "NoSourceUnpackedness" [] Prefix
+sourceNoUnpackConstr :: Constr
+sourceNoUnpackConstr
+  = mkConstr sourceUnpackednessDataType "SourceNoUnpack" [] Prefix
+sourceUnpackConstr :: Constr
+sourceUnpackConstr
+  = mkConstr sourceUnpackednessDataType "SourceUnpack" [] Prefix
+
+sourceUnpackednessDataType :: DataType
+sourceUnpackednessDataType = mkDataType "GHC.Generics.SourceUnpackedness"
+  [noSourceUnpackednessConstr,sourceNoUnpackConstr,sourceUnpackConstr]
+
+instance Data SourceUnpackedness where
+  gfoldl _ z NoSourceUnpackedness = z NoSourceUnpackedness
+  gfoldl _ z SourceNoUnpack       = z SourceNoUnpack
+  gfoldl _ z SourceUnpack         = z SourceUnpack
+  toConstr NoSourceUnpackedness = noSourceUnpackednessConstr
+  toConstr SourceNoUnpack       = sourceNoUnpackConstr
+  toConstr SourceUnpack         = sourceUnpackConstr
+  gunfold _ z c = case constrIndex c of
+                    1 -> z NoSourceUnpackedness
+                    2 -> z SourceNoUnpack
+                    3 -> z SourceUnpack
+                    _ -> errorWithoutStackTrace
+                           "Data.Data.gunfold(SourceUnpackedness)"
+  dataTypeOf _ = sourceUnpackednessDataType
+
+-----------------------------------------------------------------------
+
+noSourceStrictnessConstr :: Constr
+noSourceStrictnessConstr
+  = mkConstr sourceStrictnessDataType "NoSourceStrictness" [] Prefix
+sourceLazyConstr :: Constr
+sourceLazyConstr
+  = mkConstr sourceStrictnessDataType "SourceLazy" [] Prefix
+sourceStrictConstr :: Constr
+sourceStrictConstr
+  = mkConstr sourceStrictnessDataType "SourceStrict" [] Prefix
+
+sourceStrictnessDataType :: DataType
+sourceStrictnessDataType = mkDataType "GHC.Generics.SourceStrictness"
+  [noSourceStrictnessConstr,sourceLazyConstr,sourceStrictConstr]
+
+instance Data SourceStrictness where
+  gfoldl _ z NoSourceStrictness = z NoSourceStrictness
+  gfoldl _ z SourceLazy         = z SourceLazy
+  gfoldl _ z SourceStrict       = z SourceStrict
+  toConstr NoSourceStrictness = noSourceStrictnessConstr
+  toConstr SourceLazy         = sourceLazyConstr
+  toConstr SourceStrict       = sourceStrictConstr
+  gunfold _ z c = case constrIndex c of
+                    1 -> z NoSourceStrictness
+                    2 -> z SourceLazy
+                    3 -> z SourceStrict
+                    _ -> errorWithoutStackTrace
+                           "Data.Data.gunfold(SourceStrictness)"
+  dataTypeOf _ = sourceStrictnessDataType
+
+-----------------------------------------------------------------------
+
+decidedLazyConstr :: Constr
+decidedLazyConstr
+  = mkConstr decidedStrictnessDataType "DecidedLazy" [] Prefix
+decidedStrictConstr :: Constr
+decidedStrictConstr
+  = mkConstr decidedStrictnessDataType "DecidedStrict" [] Prefix
+decidedUnpackConstr :: Constr
+decidedUnpackConstr
+  = mkConstr decidedStrictnessDataType "DecidedUnpack" [] Prefix
+
+decidedStrictnessDataType :: DataType
+decidedStrictnessDataType = mkDataType "GHC.Generics.DecidedStrictness"
+  [decidedLazyConstr,decidedStrictConstr,decidedUnpackConstr]
+
+instance Data DecidedStrictness where
+  gfoldl _ z DecidedLazy   = z DecidedLazy
+  gfoldl _ z DecidedStrict = z DecidedStrict
+  gfoldl _ z DecidedUnpack = z DecidedUnpack
+  toConstr DecidedLazy   = decidedLazyConstr
+  toConstr DecidedStrict = decidedStrictConstr
+  toConstr DecidedUnpack = decidedUnpackConstr
+  gunfold _ z c = case constrIndex c of
+                    1 -> z DecidedLazy
+                    2 -> z DecidedStrict
+                    3 -> z DecidedUnpack
+                    _ -> errorWithoutStackTrace
+                           "Data.Data.gunfold(DecidedStrictness)"
+  dataTypeOf _ = decidedStrictnessDataType
index 3d518d5..5d758ae 100644 (file)
@@ -1,6 +1,10 @@
-{-# 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
index 9da76c6..c6a30d7 100644 (file)
@@ -1,5 +1,9 @@
-{-# 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
index 27f2c57..4e01c13 100644 (file)
@@ -1,5 +1,6 @@
 {-# 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
index 7f2f2d3..b0ccda6 100644 (file)
   * `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
index 9d42f51..b5f5a16 100644 (file)
@@ -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 #-}
 
index 79656bc..2b43dff 100644 (file)
@@ -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
index 93104f5..d072c25 100644 (file)
@@ -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)
index 1eac7e1..dcde111 100644 (file)
@@ -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