Commit 171d95df authored by Ryan Scott's avatar Ryan Scott Committed by Ben Gamari
Browse files

Missing Proxy instances, make U1 instance more Proxy-like

This accomplishes three things:

* Adds missing `Alternative`, `MonadPlus`, and `MonadZip` instances for
  `Proxy`
* Adds a missing `MonadPlus` instance for `U1`
* Changes several existing `U1` instances to use lazy pattern-matching,
  exactly how `Proxy` does it (in case we ever replace `U1` with
  `Proxy`). This is technically a breaking change (albeit an extremely
  minor one).

Test Plan: ./validate

Reviewers: austin, ekmett, hvr, bgamari

Reviewed By: bgamari

Subscribers: thomie

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

GHC Trac Issues: #11650
parent 46f3775c
......@@ -20,6 +20,7 @@ module Control.Monad.Zip where
import Control.Monad (liftM, liftM2)
import Data.Monoid
import Data.Proxy
import GHC.Generics
-- | `MonadZip` type class. Minimal definition: `mzip` or `mzipWith`
......@@ -78,7 +79,13 @@ instance MonadZip Last where
instance MonadZip f => MonadZip (Alt f) where
mzipWith f (Alt ma) (Alt mb) = Alt (mzipWith f ma mb)
instance MonadZip Proxy where
mzipWith _ _ _ = Proxy
-- Instances for GHC.Generics
instance MonadZip U1 where
mzipWith _ _ _ = U1
instance MonadZip Par1 where
mzipWith = liftM2
......
......@@ -425,8 +425,24 @@ instance Ord a => Monoid (Min a) where
| otherwise = Min n
-- Instances for GHC.Generics
instance Foldable U1 where
foldMap _ _ = mempty
{-# INLINE foldMap #-}
fold _ = mempty
{-# INLINE fold #-}
foldr _ z _ = z
{-# INLINE foldr #-}
foldl _ z _ = z
{-# INLINE foldl #-}
foldl1 _ _ = errorWithoutStackTrace "foldl1: U1"
foldr1 _ _ = errorWithoutStackTrace "foldr1: U1"
length _ = 0
null _ = True
elem _ _ = False
sum _ = 0
product _ = 1
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)
......
......@@ -89,10 +89,18 @@ instance Applicative Proxy where
_ <*> _ = Proxy
{-# INLINE (<*>) #-}
instance Alternative Proxy where
empty = Proxy
{-# INLINE empty #-}
_ <|> _ = Proxy
{-# INLINE (<|>) #-}
instance Monad Proxy where
_ >>= _ = Proxy
{-# INLINE (>>=) #-}
instance MonadPlus Proxy
-- | 'asProxyTypeOf' is a type-restricted version of 'const'.
-- It is usually used as an infix operator, and its typing forces its first
-- argument (which is usually overloaded) to have the same type as the tag
......
......@@ -228,8 +228,17 @@ instance Traversable ZipList where
traverse f (ZipList x) = ZipList <$> traverse f x
-- Instances for GHC.Generics
instance Traversable U1 where
traverse _ _ = pure U1
{-# INLINE traverse #-}
sequenceA _ = pure U1
{-# INLINE sequenceA #-}
mapM _ _ = pure U1
{-# INLINE mapM #-}
sequence _ = pure U1
{-# INLINE sequence #-}
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)
......
......@@ -712,10 +712,10 @@ import GHC.Types
import GHC.Arr ( Ix )
import GHC.Base ( Alternative(..), Applicative(..), Functor(..)
, Monad(..), MonadPlus(..), String )
import GHC.Classes ( Eq, Ord )
import GHC.Classes ( Eq(..), Ord(..) )
import GHC.Enum ( Bounded, Enum )
import GHC.Read ( Read )
import GHC.Show ( Show )
import GHC.Read ( Read(..), lex, readParen )
import GHC.Show ( Show(..), showString )
-- Needed for metadata
import Data.Proxy ( Proxy(..), KProxy(..) )
......@@ -736,21 +736,35 @@ deriving instance Show (V1 p)
-- | Unit: used for constructors without arguments
data U1 (p :: *) = U1
deriving (Eq, Ord, Read, Show, Functor, Generic, Generic1)
deriving (Generic, Generic1)
instance Eq (U1 p) where
_ == _ = True
instance Ord (U1 p) where
compare _ _ = EQ
instance Read (U1 p) where
readsPrec d = readParen (d > 10) (\r -> [(U1, s) | ("U1",s) <- lex r ])
instance Show (U1 p) where
showsPrec _ _ = showString "U1"
instance Functor U1 where
fmap _ _ = U1
instance Applicative U1 where
pure _ = U1
U1 <*> U1 = U1
_ <*> _ = U1
instance Alternative U1 where
empty = U1
U1 <|> U1 = U1
-- The defaults will otherwise bottom; see #11650.
some U1 = U1
many U1 = U1
_ <|> _ = U1
instance Monad U1 where
U1 >>= _ = U1
_ >>= _ = U1
instance MonadPlus U1
-- | Used for marking occurrences of the parameter
newtype Par1 p = Par1 { unPar1 :: p }
......
......@@ -49,6 +49,9 @@
`GHC.Generics` as part of making GHC generics capable of handling
unlifted types (#10868)
* The `Eq`, `Ord`, `Read`, and `Show` instances for `U1` now use lazier
pattern-matching
* Keep `shift{L,R}` on `Integer` with negative shift-arguments from
segfaulting (#10571)
......
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