diff options
Diffstat (limited to 'libraries/base/Data/Functor')
| -rw-r--r-- | libraries/base/Data/Functor/Classes.hs | 36 | ||||
| -rw-r--r-- | libraries/base/Data/Functor/Compose.hs | 13 | ||||
| -rw-r--r-- | libraries/base/Data/Functor/Const.hs | 7 | ||||
| -rw-r--r-- | libraries/base/Data/Functor/Identity.hs | 10 | ||||
| -rw-r--r-- | libraries/base/Data/Functor/Product.hs | 20 | ||||
| -rw-r--r-- | libraries/base/Data/Functor/Sum.hs | 11 |
6 files changed, 97 insertions, 0 deletions
diff --git a/libraries/base/Data/Functor/Classes.hs b/libraries/base/Data/Functor/Classes.hs index ce84af0533..460ecc128a 100644 --- a/libraries/base/Data/Functor/Classes.hs +++ b/libraries/base/Data/Functor/Classes.hs @@ -214,53 +214,64 @@ showsPrec2 = liftShowsPrec2 showsPrec showList showsPrec showList -- Instances for Prelude type constructors +-- | @since 4.9.0.0 instance Eq1 Maybe where liftEq _ Nothing Nothing = True liftEq _ Nothing (Just _) = False liftEq _ (Just _) Nothing = False liftEq eq (Just x) (Just y) = eq x y +-- | @since 4.9.0.0 instance Ord1 Maybe where liftCompare _ Nothing Nothing = EQ liftCompare _ Nothing (Just _) = LT liftCompare _ (Just _) Nothing = GT liftCompare comp (Just x) (Just y) = comp x y +-- | @since 4.9.0.0 instance Read1 Maybe where liftReadsPrec rp _ d = readParen False (\ r -> [(Nothing,s) | ("Nothing",s) <- lex r]) `mappend` readsData (readsUnaryWith rp "Just" Just) d +-- | @since 4.9.0.0 instance Show1 Maybe where liftShowsPrec _ _ _ Nothing = showString "Nothing" liftShowsPrec sp _ d (Just x) = showsUnaryWith sp "Just" d x +-- | @since 4.9.0.0 instance Eq1 [] where liftEq _ [] [] = True liftEq _ [] (_:_) = False liftEq _ (_:_) [] = False liftEq eq (x:xs) (y:ys) = eq x y && liftEq eq xs ys +-- | @since 4.9.0.0 instance Ord1 [] where liftCompare _ [] [] = EQ liftCompare _ [] (_:_) = LT liftCompare _ (_:_) [] = GT liftCompare comp (x:xs) (y:ys) = comp x y `mappend` liftCompare comp xs ys +-- | @since 4.9.0.0 instance Read1 [] where liftReadsPrec _ rl _ = rl +-- | @since 4.9.0.0 instance Show1 [] where liftShowsPrec _ sl _ = sl +-- | @since 4.9.0.0 instance Eq2 (,) where liftEq2 e1 e2 (x1, y1) (x2, y2) = e1 x1 x2 && e2 y1 y2 +-- | @since 4.9.0.0 instance Ord2 (,) where liftCompare2 comp1 comp2 (x1, y1) (x2, y2) = comp1 x1 x2 `mappend` comp2 y1 y2 +-- | @since 4.9.0.0 instance Read2 (,) where liftReadsPrec2 rp1 _ rp2 _ _ = readParen False $ \ r -> [((x,y), w) | ("(",s) <- lex r, @@ -269,89 +280,114 @@ instance Read2 (,) where (y,v) <- rp2 0 u, (")",w) <- lex v] +-- | @since 4.9.0.0 instance Show2 (,) where liftShowsPrec2 sp1 _ sp2 _ _ (x, y) = showChar '(' . sp1 0 x . showChar ',' . sp2 0 y . showChar ')' +-- | @since 4.9.0.0 instance (Eq a) => Eq1 ((,) a) where liftEq = liftEq2 (==) +-- | @since 4.9.0.0 instance (Ord a) => Ord1 ((,) a) where liftCompare = liftCompare2 compare +-- | @since 4.9.0.0 instance (Read a) => Read1 ((,) a) where liftReadsPrec = liftReadsPrec2 readsPrec readList +-- | @since 4.9.0.0 instance (Show a) => Show1 ((,) a) where liftShowsPrec = liftShowsPrec2 showsPrec showList +-- | @since 4.9.0.0 instance Eq2 Either where liftEq2 e1 _ (Left x) (Left y) = e1 x y liftEq2 _ _ (Left _) (Right _) = False liftEq2 _ _ (Right _) (Left _) = False liftEq2 _ e2 (Right x) (Right y) = e2 x y +-- | @since 4.9.0.0 instance Ord2 Either where liftCompare2 comp1 _ (Left x) (Left y) = comp1 x y liftCompare2 _ _ (Left _) (Right _) = LT liftCompare2 _ _ (Right _) (Left _) = GT liftCompare2 _ comp2 (Right x) (Right y) = comp2 x y +-- | @since 4.9.0.0 instance Read2 Either where liftReadsPrec2 rp1 _ rp2 _ = readsData $ readsUnaryWith rp1 "Left" Left `mappend` readsUnaryWith rp2 "Right" Right +-- | @since 4.9.0.0 instance Show2 Either where liftShowsPrec2 sp1 _ _ _ d (Left x) = showsUnaryWith sp1 "Left" d x liftShowsPrec2 _ _ sp2 _ d (Right x) = showsUnaryWith sp2 "Right" d x +-- | @since 4.9.0.0 instance (Eq a) => Eq1 (Either a) where liftEq = liftEq2 (==) +-- | @since 4.9.0.0 instance (Ord a) => Ord1 (Either a) where liftCompare = liftCompare2 compare +-- | @since 4.9.0.0 instance (Read a) => Read1 (Either a) where liftReadsPrec = liftReadsPrec2 readsPrec readList +-- | @since 4.9.0.0 instance (Show a) => Show1 (Either a) where liftShowsPrec = liftShowsPrec2 showsPrec showList -- Instances for other functors defined in the base package +-- | @since 4.9.0.0 instance Eq1 Identity where liftEq eq (Identity x) (Identity y) = eq x y +-- | @since 4.9.0.0 instance Ord1 Identity where liftCompare comp (Identity x) (Identity y) = comp x y +-- | @since 4.9.0.0 instance Read1 Identity where liftReadsPrec rp _ = readsData $ readsUnaryWith rp "Identity" Identity +-- | @since 4.9.0.0 instance Show1 Identity where liftShowsPrec sp _ d (Identity x) = showsUnaryWith sp "Identity" d x +-- | @since 4.9.0.0 instance Eq2 Const where liftEq2 eq _ (Const x) (Const y) = eq x y +-- | @since 4.9.0.0 instance Ord2 Const where liftCompare2 comp _ (Const x) (Const y) = comp x y +-- | @since 4.9.0.0 instance Read2 Const where liftReadsPrec2 rp _ _ _ = readsData $ readsUnaryWith rp "Const" Const +-- | @since 4.9.0.0 instance Show2 Const where liftShowsPrec2 sp _ _ _ d (Const x) = showsUnaryWith sp "Const" d x +-- | @since 4.9.0.0 instance (Eq a) => Eq1 (Const a) where liftEq = liftEq2 (==) +-- | @since 4.9.0.0 instance (Ord a) => Ord1 (Const a) where liftCompare = liftCompare2 compare +-- | @since 4.9.0.0 instance (Read a) => Read1 (Const a) where liftReadsPrec = liftReadsPrec2 readsPrec readList +-- | @since 4.9.0.0 instance (Show a) => Show1 (Const a) where liftShowsPrec = liftShowsPrec2 showsPrec showList diff --git a/libraries/base/Data/Functor/Compose.hs b/libraries/base/Data/Functor/Compose.hs index d548836820..a09b2acafe 100644 --- a/libraries/base/Data/Functor/Compose.hs +++ b/libraries/base/Data/Functor/Compose.hs @@ -39,13 +39,16 @@ newtype Compose f g a = Compose { getCompose :: f (g a) } -- Instances of lifted Prelude classes +-- | @since 4.9.0.0 instance (Eq1 f, Eq1 g) => Eq1 (Compose f g) where liftEq eq (Compose x) (Compose y) = liftEq (liftEq eq) x y +-- | @since 4.9.0.0 instance (Ord1 f, Ord1 g) => Ord1 (Compose f g) where liftCompare comp (Compose x) (Compose y) = liftCompare (liftCompare comp) x y +-- | @since 4.9.0.0 instance (Read1 f, Read1 g) => Read1 (Compose f g) where liftReadsPrec rp rl = readsData $ readsUnaryWith (liftReadsPrec rp' rl') "Compose" Compose @@ -53,6 +56,7 @@ instance (Read1 f, Read1 g) => Read1 (Compose f g) where rp' = liftReadsPrec rp rl rl' = liftReadList rp rl +-- | @since 4.9.0.0 instance (Show1 f, Show1 g) => Show1 (Compose f g) where liftShowsPrec sp sl d (Compose x) = showsUnaryWith (liftShowsPrec sp' sl') "Compose" d x @@ -62,33 +66,42 @@ instance (Show1 f, Show1 g) => Show1 (Compose f g) where -- Instances of Prelude classes +-- | @since 4.9.0.0 instance (Eq1 f, Eq1 g, Eq a) => Eq (Compose f g a) where (==) = eq1 +-- | @since 4.9.0.0 instance (Ord1 f, Ord1 g, Ord a) => Ord (Compose f g a) where compare = compare1 +-- | @since 4.9.0.0 instance (Read1 f, Read1 g, Read a) => Read (Compose f g a) where readsPrec = readsPrec1 +-- | @since 4.9.0.0 instance (Show1 f, Show1 g, Show a) => Show (Compose f g a) where showsPrec = showsPrec1 -- Functor instances +-- | @since 4.9.0.0 instance (Functor f, Functor g) => Functor (Compose f g) where fmap f (Compose x) = Compose (fmap (fmap f) x) +-- | @since 4.9.0.0 instance (Foldable f, Foldable g) => Foldable (Compose f g) where foldMap f (Compose t) = foldMap (foldMap f) t +-- | @since 4.9.0.0 instance (Traversable f, Traversable g) => Traversable (Compose f g) where traverse f (Compose t) = Compose <$> traverse (traverse f) t +-- | @since 4.9.0.0 instance (Applicative f, Applicative g) => Applicative (Compose f g) where pure x = Compose (pure (pure x)) Compose f <*> Compose x = Compose ((<*>) <$> f <*> x) +-- | @since 4.9.0.0 instance (Alternative f, Applicative g) => Alternative (Compose f g) where empty = Compose empty Compose x <|> Compose y = Compose (x <|> y) diff --git a/libraries/base/Data/Functor/Const.hs b/libraries/base/Data/Functor/Const.hs index 9f2db7f1dc..8f54b4204c 100644 --- a/libraries/base/Data/Functor/Const.hs +++ b/libraries/base/Data/Functor/Const.hs @@ -43,22 +43,29 @@ newtype Const a b = Const { getConst :: a } -- | This instance would be equivalent to the derived instances of the -- 'Const' newtype if the 'runConst' field were removed +-- +-- @since 4.8.0.0 instance Read a => Read (Const a b) where readsPrec d = readParen (d > 10) $ \r -> [(Const x,t) | ("Const", s) <- lex r, (x, t) <- readsPrec 11 s] -- | This instance would be equivalent to the derived instances of the -- 'Const' newtype if the 'runConst' field were removed +-- +-- @since 4.8.0.0 instance Show a => Show (Const a b) where showsPrec d (Const x) = showParen (d > 10) $ showString "Const " . showsPrec 11 x +-- | @since 4.7.0.0 instance Foldable (Const m) where foldMap _ _ = mempty +-- | @since 2.01 instance Functor (Const m) where fmap _ (Const v) = Const v +-- | @since 2.0.1 instance Monoid m => Applicative (Const m) where pure _ = Const mempty (<*>) = coerce (mappend :: m -> m -> m) diff --git a/libraries/base/Data/Functor/Identity.hs b/libraries/base/Data/Functor/Identity.hs index 4e6646a6ea..1adfaebeff 100644 --- a/libraries/base/Data/Functor/Identity.hs +++ b/libraries/base/Data/Functor/Identity.hs @@ -56,12 +56,16 @@ newtype Identity a = Identity { runIdentity :: a } -- | This instance would be equivalent to the derived instances of the -- 'Identity' newtype if the 'runIdentity' field were removed +-- +-- @since 4.8.0.0 instance (Read a) => Read (Identity a) where readsPrec d = readParen (d > 10) $ \ r -> [(Identity x,t) | ("Identity",s) <- lex r, (x,t) <- readsPrec 11 s] -- | This instance would be equivalent to the derived instances of the -- 'Identity' newtype if the 'runIdentity' field were removed +-- +-- @since 4.8.0.0 instance (Show a) => Show (Identity a) where showsPrec d (Identity x) = showParen (d > 10) $ showString "Identity " . showsPrec 11 x @@ -69,6 +73,7 @@ instance (Show a) => Show (Identity a) where -- --------------------------------------------------------------------------- -- Identity instances for Functor and Monad +-- | @since 4.8.0.0 instance Foldable Identity where foldMap = coerce @@ -87,19 +92,24 @@ instance Foldable Identity where sum = runIdentity toList (Identity x) = [x] +-- | @since 4.8.0.0 instance Functor Identity where fmap = coerce +-- | @since 4.8.0.0 instance Applicative Identity where pure = Identity (<*>) = coerce +-- | @since 4.8.0.0 instance Monad Identity where m >>= k = k (runIdentity m) +-- | @since 4.8.0.0 instance MonadFix Identity where mfix f = Identity (fix (runIdentity . f)) +-- | @since 4.8.0.0 instance MonadZip Identity where mzipWith = coerce munzip = coerce diff --git a/libraries/base/Data/Functor/Product.hs b/libraries/base/Data/Functor/Product.hs index 9d6d6a62b9..a70f04b661 100644 --- a/libraries/base/Data/Functor/Product.hs +++ b/libraries/base/Data/Functor/Product.hs @@ -36,62 +36,82 @@ import GHC.Generics (Generic, Generic1) data Product f g a = Pair (f a) (g a) deriving (Data, Generic, Generic1) +-- | @since 4.9.0.0 instance (Eq1 f, Eq1 g) => Eq1 (Product f g) where liftEq eq (Pair x1 y1) (Pair x2 y2) = liftEq eq x1 x2 && liftEq eq y1 y2 +-- | @since 4.9.0.0 instance (Ord1 f, Ord1 g) => Ord1 (Product f g) where liftCompare comp (Pair x1 y1) (Pair x2 y2) = liftCompare comp x1 x2 `mappend` liftCompare comp y1 y2 +-- | @since 4.9.0.0 instance (Read1 f, Read1 g) => Read1 (Product f g) where liftReadsPrec rp rl = readsData $ readsBinaryWith (liftReadsPrec rp rl) (liftReadsPrec rp rl) "Pair" Pair +-- | @since 4.9.0.0 instance (Show1 f, Show1 g) => Show1 (Product f g) where liftShowsPrec sp sl d (Pair x y) = showsBinaryWith (liftShowsPrec sp sl) (liftShowsPrec sp sl) "Pair" d x y +-- | @since 4.9.0.0 instance (Eq1 f, Eq1 g, Eq a) => Eq (Product f g a) where (==) = eq1 + +-- | @since 4.9.0.0 instance (Ord1 f, Ord1 g, Ord a) => Ord (Product f g a) where compare = compare1 + +-- | @since 4.9.0.0 instance (Read1 f, Read1 g, Read a) => Read (Product f g a) where readsPrec = readsPrec1 + +-- | @since 4.9.0.0 instance (Show1 f, Show1 g, Show a) => Show (Product f g a) where showsPrec = showsPrec1 +-- | @since 4.9.0.0 instance (Functor f, Functor g) => Functor (Product f g) where fmap f (Pair x y) = Pair (fmap f x) (fmap f y) +-- | @since 4.9.0.0 instance (Foldable f, Foldable g) => Foldable (Product f g) where foldMap f (Pair x y) = foldMap f x `mappend` foldMap f y +-- | @since 4.9.0.0 instance (Traversable f, Traversable g) => Traversable (Product f g) where traverse f (Pair x y) = Pair <$> traverse f x <*> traverse f y +-- | @since 4.9.0.0 instance (Applicative f, Applicative g) => Applicative (Product f g) where pure x = Pair (pure x) (pure x) Pair f g <*> Pair x y = Pair (f <*> x) (g <*> y) +-- | @since 4.9.0.0 instance (Alternative f, Alternative g) => Alternative (Product f g) where empty = Pair empty empty Pair x1 y1 <|> Pair x2 y2 = Pair (x1 <|> x2) (y1 <|> y2) +-- | @since 4.9.0.0 instance (Monad f, Monad g) => Monad (Product f g) where Pair m n >>= f = Pair (m >>= fstP . f) (n >>= sndP . f) where fstP (Pair a _) = a sndP (Pair _ b) = b +-- | @since 4.9.0.0 instance (MonadPlus f, MonadPlus g) => MonadPlus (Product f g) where mzero = Pair mzero mzero Pair x1 y1 `mplus` Pair x2 y2 = Pair (x1 `mplus` x2) (y1 `mplus` y2) +-- | @since 4.9.0.0 instance (MonadFix f, MonadFix g) => MonadFix (Product f g) where mfix f = Pair (mfix (fstP . f)) (mfix (sndP . f)) where fstP (Pair a _) = a sndP (Pair _ b) = b +-- | @since 4.9.0.0 instance (MonadZip f, MonadZip g) => MonadZip (Product f g) where mzipWith f (Pair x1 y1) (Pair x2 y2) = Pair (mzipWith f x1 x2) (mzipWith f y1 y2) diff --git a/libraries/base/Data/Functor/Sum.hs b/libraries/base/Data/Functor/Sum.hs index f5bee11bad..9279de45f9 100644 --- a/libraries/base/Data/Functor/Sum.hs +++ b/libraries/base/Data/Functor/Sum.hs @@ -32,46 +32,57 @@ import GHC.Generics (Generic, Generic1) data Sum f g a = InL (f a) | InR (g a) deriving (Data, Generic, Generic1) +-- | @since 4.9.0.0 instance (Eq1 f, Eq1 g) => Eq1 (Sum f g) where liftEq eq (InL x1) (InL x2) = liftEq eq x1 x2 liftEq _ (InL _) (InR _) = False liftEq _ (InR _) (InL _) = False liftEq eq (InR y1) (InR y2) = liftEq eq y1 y2 +-- | @since 4.9.0.0 instance (Ord1 f, Ord1 g) => Ord1 (Sum f g) where liftCompare comp (InL x1) (InL x2) = liftCompare comp x1 x2 liftCompare _ (InL _) (InR _) = LT liftCompare _ (InR _) (InL _) = GT liftCompare comp (InR y1) (InR y2) = liftCompare comp y1 y2 +-- | @since 4.9.0.0 instance (Read1 f, Read1 g) => Read1 (Sum f g) where liftReadsPrec rp rl = readsData $ readsUnaryWith (liftReadsPrec rp rl) "InL" InL `mappend` readsUnaryWith (liftReadsPrec rp rl) "InR" InR +-- | @since 4.9.0.0 instance (Show1 f, Show1 g) => Show1 (Sum f g) where liftShowsPrec sp sl d (InL x) = showsUnaryWith (liftShowsPrec sp sl) "InL" d x liftShowsPrec sp sl d (InR y) = showsUnaryWith (liftShowsPrec sp sl) "InR" d y +-- | @since 4.9.0.0 instance (Eq1 f, Eq1 g, Eq a) => Eq (Sum f g a) where (==) = eq1 +-- | @since 4.9.0.0 instance (Ord1 f, Ord1 g, Ord a) => Ord (Sum f g a) where compare = compare1 +-- | @since 4.9.0.0 instance (Read1 f, Read1 g, Read a) => Read (Sum f g a) where readsPrec = readsPrec1 +-- | @since 4.9.0.0 instance (Show1 f, Show1 g, Show a) => Show (Sum f g a) where showsPrec = showsPrec1 +-- | @since 4.9.0.0 instance (Functor f, Functor g) => Functor (Sum f g) where fmap f (InL x) = InL (fmap f x) fmap f (InR y) = InR (fmap f y) +-- | @since 4.9.0.0 instance (Foldable f, Foldable g) => Foldable (Sum f g) where foldMap f (InL x) = foldMap f x foldMap f (InR y) = foldMap f y +-- | @since 4.9.0.0 instance (Traversable f, Traversable g) => Traversable (Sum f g) where traverse f (InL x) = InL <$> traverse f x traverse f (InR y) = InR <$> traverse f y |