summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libraries/base/Control/Monad/Zip.hs6
-rw-r--r--libraries/base/Data/Bifoldable.hs428
-rw-r--r--libraries/base/Data/Bitraversable.hs228
-rw-r--r--libraries/base/Data/Data.hs28
-rw-r--r--libraries/base/Data/Foldable.hs64
-rw-r--r--libraries/base/Data/Functor/Identity.hs34
-rw-r--r--libraries/base/Data/Functor/Utils.hs106
-rw-r--r--libraries/base/Data/Semigroup.hs31
-rw-r--r--libraries/base/Data/String.hs10
-rw-r--r--libraries/base/Data/Traversable.hs50
-rw-r--r--libraries/base/base.cabal3
-rw-r--r--libraries/base/changelog.md3
-rw-r--r--testsuite/tests/annotations/should_fail/annfail10.stderr4
-rw-r--r--testsuite/tests/perf/compiler/all.T3
-rw-r--r--testsuite/tests/typecheck/should_fail/T10971b.stderr8
15 files changed, 847 insertions, 159 deletions
diff --git a/libraries/base/Control/Monad/Zip.hs b/libraries/base/Control/Monad/Zip.hs
index f102ff06ad..5b670085d4 100644
--- a/libraries/base/Control/Monad/Zip.hs
+++ b/libraries/base/Control/Monad/Zip.hs
@@ -19,6 +19,7 @@
module Control.Monad.Zip where
import Control.Monad (liftM, liftM2)
+import Data.Functor.Identity
import Data.Monoid
import Data.Proxy
import GHC.Generics
@@ -59,6 +60,11 @@ instance MonadZip [] where
munzip = unzip
-- | @since 4.8.0.0
+instance MonadZip Identity where
+ mzipWith = liftM2
+ munzip (Identity (a, b)) = (Identity a, Identity b)
+
+-- | @since 4.8.0.0
instance MonadZip Dual where
-- Cannot use coerce, it's unsafe
mzipWith = liftM2
diff --git a/libraries/base/Data/Bifoldable.hs b/libraries/base/Data/Bifoldable.hs
new file mode 100644
index 0000000000..11a1c25df5
--- /dev/null
+++ b/libraries/base/Data/Bifoldable.hs
@@ -0,0 +1,428 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module : Data.Bifoldable
+-- Copyright : (C) 2011-2016 Edward Kmett
+-- License : BSD-style (see the file LICENSE)
+--
+-- Maintainer : libraries@haskell.org
+-- Stability : provisional
+-- Portability : portable
+--
+-- @since 4.10.0.0
+----------------------------------------------------------------------------
+module Data.Bifoldable
+ ( Bifoldable(..)
+ , bifoldr'
+ , bifoldr1
+ , bifoldrM
+ , bifoldl'
+ , bifoldl1
+ , bifoldlM
+ , bitraverse_
+ , bifor_
+ , bimapM_
+ , biforM_
+ , bimsum
+ , bisequenceA_
+ , bisequence_
+ , biasum
+ , biList
+ , binull
+ , bilength
+ , bielem
+ , bimaximum
+ , biminimum
+ , bisum
+ , biproduct
+ , biconcat
+ , biconcatMap
+ , biand
+ , bior
+ , biany
+ , biall
+ , bimaximumBy
+ , biminimumBy
+ , binotElem
+ , bifind
+ ) where
+
+import Control.Applicative
+import Data.Functor.Utils (Max(..), Min(..), (#.))
+import Data.Maybe (fromMaybe)
+import Data.Monoid
+import GHC.Generics (K1(..))
+
+-- | 'Bifoldable' identifies foldable structures with two different varieties
+-- of elements (as opposed to 'Foldable', which has one variety of element).
+-- Common examples are 'Either' and '(,)':
+--
+-- > instance Bifoldable Either where
+-- > bifoldMap f _ (Left a) = f a
+-- > bifoldMap _ g (Right b) = g b
+-- >
+-- > instance Bifoldable (,) where
+-- > bifoldr f g z (a, b) = f a (g b z)
+--
+-- A minimal 'Bifoldable' definition consists of either 'bifoldMap' or
+-- 'bifoldr'. When defining more than this minimal set, one should ensure
+-- that the following identities hold:
+--
+-- @
+-- 'bifold' ≡ 'bifoldMap' 'id' 'id'
+-- 'bifoldMap' f g ≡ 'bifoldr' ('mappend' . f) ('mappend' . g) 'mempty'
+-- 'bifoldr' f g z t ≡ 'appEndo' ('bifoldMap' (Endo . f) (Endo . g) t) z
+-- @
+--
+-- If the type is also a 'Bifunctor' instance, it should satisfy:
+--
+-- > 'bifoldMap' f g ≡ 'bifold' . 'bimap' f g
+--
+-- which implies that
+--
+-- > 'bifoldMap' f g . 'bimap' h i ≡ 'bifoldMap' (f . h) (g . i)
+--
+-- @since 4.10.0.0
+class Bifoldable p where
+ {-# MINIMAL bifoldr | bifoldMap #-}
+
+ -- | Combines the elements of a structure using a monoid.
+ --
+ -- @'bifold' ≡ 'bifoldMap' 'id' 'id'@
+ --
+ -- @since 4.10.0.0
+ bifold :: Monoid m => p m m -> m
+ bifold = bifoldMap id id
+
+ -- | Combines the elements of a structure, given ways of mapping them to a
+ -- common monoid.
+ --
+ -- @'bifoldMap' f g
+ -- ≡ 'bifoldr' ('mappend' . f) ('mappend' . g) 'mempty'@
+ --
+ -- @since 4.10.0.0
+ bifoldMap :: Monoid m => (a -> m) -> (b -> m) -> p a b -> m
+ bifoldMap f g = bifoldr (mappend . f) (mappend . g) mempty
+
+ -- | Combines the elements of a structure in a right associative manner.
+ -- Given a hypothetical function @toEitherList :: p a b -> [Either a b]@
+ -- yielding a list of all elements of a structure in order, the following
+ -- would hold:
+ --
+ -- @'bifoldr' f g z ≡ 'foldr' ('either' f g) z . toEitherList@
+ --
+ -- @since 4.10.0.0
+ bifoldr :: (a -> c -> c) -> (b -> c -> c) -> c -> p a b -> c
+ bifoldr f g z t = appEndo (bifoldMap (Endo #. f) (Endo #. g) t) z
+
+ -- | Combines the elments of a structure in a left associative manner. Given
+ -- a hypothetical function @toEitherList :: p a b -> [Either a b]@ yielding a
+ -- list of all elements of a structure in order, the following would hold:
+ --
+ -- @'bifoldl' f g z
+ -- ≡ 'foldl' (\acc -> 'either' (f acc) (g acc)) z . toEitherList@
+ --
+ -- Note that if you want an efficient left-fold, you probably want to use
+ -- 'bifoldl'' instead of 'bifoldl'. The reason is that the latter does not
+ -- force the "inner" results, resulting in a thunk chain which then must be
+ -- evaluated from the outside-in.
+ --
+ -- @since 4.10.0.0
+ bifoldl :: (c -> a -> c) -> (c -> b -> c) -> c -> p a b -> c
+ bifoldl f g z t = appEndo (getDual (bifoldMap (Dual . Endo . flip f)
+ (Dual . Endo . flip g) t)) z
+
+-- | @since 4.10.0.0
+instance Bifoldable (,) where
+ bifoldMap f g ~(a, b) = f a `mappend` g b
+
+-- | @since 4.10.0.0
+instance Bifoldable Const where
+ bifoldMap f _ (Const a) = f a
+
+-- | @since 4.10.0.0
+instance Bifoldable (K1 i) where
+ bifoldMap f _ (K1 c) = f c
+
+-- | @since 4.10.0.0
+instance Bifoldable ((,,) x) where
+ bifoldMap f g ~(_,a,b) = f a `mappend` g b
+
+-- | @since 4.10.0.0
+instance Bifoldable ((,,,) x y) where
+ bifoldMap f g ~(_,_,a,b) = f a `mappend` g b
+
+-- | @since 4.10.0.0
+instance Bifoldable ((,,,,) x y z) where
+ bifoldMap f g ~(_,_,_,a,b) = f a `mappend` g b
+
+-- | @since 4.10.0.0
+instance Bifoldable ((,,,,,) x y z w) where
+ bifoldMap f g ~(_,_,_,_,a,b) = f a `mappend` g b
+
+-- | @since 4.10.0.0
+instance Bifoldable ((,,,,,,) x y z w v) where
+ bifoldMap f g ~(_,_,_,_,_,a,b) = f a `mappend` g b
+
+-- | @since 4.10.0.0
+instance Bifoldable Either where
+ bifoldMap f _ (Left a) = f a
+ bifoldMap _ g (Right b) = g b
+
+-- | As 'bifoldr', but strict in the result of the reduction functions at each
+-- step.
+--
+-- @since 4.10.0.0
+bifoldr' :: Bifoldable t => (a -> c -> c) -> (b -> c -> c) -> c -> t a b -> c
+bifoldr' f g z0 xs = bifoldl f' g' id xs z0 where
+ f' k x z = k $! f x z
+ g' k x z = k $! g x z
+
+-- | A variant of 'bifoldr' that has no base case,
+-- and thus may only be applied to non-empty structures.
+--
+-- @since 4.10.0.0
+bifoldr1 :: Bifoldable t => (a -> a -> a) -> t a a -> a
+bifoldr1 f xs = fromMaybe (error "bifoldr1: empty structure")
+ (bifoldr mbf mbf Nothing xs)
+ where
+ mbf x m = Just (case m of
+ Nothing -> x
+ Just y -> f x y)
+
+-- | Right associative monadic bifold over a structure.
+--
+-- @since 4.10.0.0
+bifoldrM :: (Bifoldable t, Monad m)
+ => (a -> c -> m c) -> (b -> c -> m c) -> c -> t a b -> m c
+bifoldrM f g z0 xs = bifoldl f' g' return xs z0 where
+ f' k x z = f x z >>= k
+ g' k x z = g x z >>= k
+
+-- | As 'bifoldl', but strict in the result of the reduction functions at each
+-- step.
+--
+-- This ensures that each step of the bifold is forced to weak head normal form
+-- before being applied, avoiding the collection of thunks that would otherwise
+-- occur. This is often what you want to strictly reduce a finite structure to
+-- a single, monolithic result (e.g., 'bilength').
+--
+-- @since 4.10.0.0
+bifoldl':: Bifoldable t => (a -> b -> a) -> (a -> c -> a) -> a -> t b c -> a
+bifoldl' f g z0 xs = bifoldr f' g' id xs z0 where
+ f' x k z = k $! f z x
+ g' x k z = k $! g z x
+
+-- | A variant of 'bifoldl' that has no base case,
+-- and thus may only be applied to non-empty structures.
+--
+-- @since 4.10.0.0
+bifoldl1 :: Bifoldable t => (a -> a -> a) -> t a a -> a
+bifoldl1 f xs = fromMaybe (error "bifoldl1: empty structure")
+ (bifoldl mbf mbf Nothing xs)
+ where
+ mbf m y = Just (case m of
+ Nothing -> y
+ Just x -> f x y)
+
+-- | Left associative monadic bifold over a structure.
+--
+-- @since 4.10.0.0
+bifoldlM :: (Bifoldable t, Monad m)
+ => (a -> b -> m a) -> (a -> c -> m a) -> a -> t b c -> m a
+bifoldlM f g z0 xs = bifoldr f' g' return xs z0 where
+ f' x k z = f z x >>= k
+ g' x k z = g z x >>= k
+
+-- | Map each element of a structure using one of two actions, evaluate these
+-- actions from left to right, and ignore the results. For a version that
+-- doesn't ignore the results, see 'Data.Bitraversable.bitraverse'.
+--
+-- @since 4.10.0.0
+bitraverse_ :: (Bifoldable t, Applicative f)
+ => (a -> f c) -> (b -> f d) -> t a b -> f ()
+bitraverse_ f g = bifoldr ((*>) . f) ((*>) . g) (pure ())
+
+-- | As 'bitraverse_', but with the structure as the primary argument. For a
+-- version that doesn't ignore the results, see 'Data.Bitraversable.bifor'.
+--
+-- >>> > bifor_ ('a', "bc") print (print . reverse)
+-- 'a'
+-- "cb"
+--
+-- @since 4.10.0.0
+bifor_ :: (Bifoldable t, Applicative f)
+ => t a b -> (a -> f c) -> (b -> f d) -> f ()
+bifor_ t f g = bitraverse_ f g t
+
+-- | Alias for 'bitraverse_'.
+--
+-- @since 4.10.0.0
+bimapM_ :: (Bifoldable t, Applicative f)
+ => (a -> f c) -> (b -> f d) -> t a b -> f ()
+bimapM_ = bitraverse_
+
+-- | Alias for 'bifor_'.
+--
+-- @since 4.10.0.0
+biforM_ :: (Bifoldable t, Applicative f)
+ => t a b -> (a -> f c) -> (b -> f d) -> f ()
+biforM_ = bifor_
+
+-- | Alias for 'bisequence_'.
+--
+-- @since 4.10.0.0
+bisequenceA_ :: (Bifoldable t, Applicative f) => t (f a) (f b) -> f ()
+bisequenceA_ = bisequence_
+
+-- | Evaluate each action in the structure from left to right, and ignore the
+-- results. For a version that doesn't ignore the results, see
+-- 'Data.Bitraversable.bisequence'.
+--
+-- @since 4.10.0.0
+bisequence_ :: (Bifoldable t, Applicative f) => t (f a) (f b) -> f ()
+bisequence_ = bifoldr (*>) (*>) (pure ())
+
+-- | The sum of a collection of actions, generalizing 'biconcat'.
+--
+-- @since 4.10.0.0
+biasum :: (Bifoldable t, Alternative f) => t (f a) (f a) -> f a
+biasum = bifoldr (<|>) (<|>) empty
+
+-- | Alias for 'biasum'.
+--
+-- @since 4.10.0.0
+bimsum :: (Bifoldable t, Alternative f) => t (f a) (f a) -> f a
+bimsum = biasum
+
+-- | Collects the list of elements of a structure, from left to right.
+--
+-- @since 4.10.0.0
+biList :: Bifoldable t => t a a -> [a]
+biList = bifoldr (:) (:) []
+
+-- | Test whether the structure is empty.
+--
+-- @since 4.10.0.0
+binull :: Bifoldable t => t a b -> Bool
+binull = bifoldr (\_ _ -> False) (\_ _ -> False) True
+
+-- | Returns the size/length of a finite structure as an 'Int'.
+--
+-- @since 4.10.0.0
+bilength :: Bifoldable t => t a b -> Int
+bilength = bifoldl' (\c _ -> c+1) (\c _ -> c+1) 0
+
+-- | Does the element occur in the structure?
+--
+-- @since 4.10.0.0
+bielem :: (Bifoldable t, Eq a) => a -> t a a -> Bool
+bielem x = biany (== x) (== x)
+
+-- | Reduces a structure of lists to the concatenation of those lists.
+--
+-- @since 4.10.0.0
+biconcat :: Bifoldable t => t [a] [a] -> [a]
+biconcat = bifold
+
+-- | The largest element of a non-empty structure.
+--
+-- @since 4.10.0.0
+bimaximum :: forall t a. (Bifoldable t, Ord a) => t a a -> a
+bimaximum = fromMaybe (error "bimaximum: empty structure") .
+ getMax . bifoldMap mj mj
+ where mj = Max #. (Just :: a -> Maybe a)
+
+-- | The least element of a non-empty structure.
+--
+-- @since 4.10.0.0
+biminimum :: forall t a. (Bifoldable t, Ord a) => t a a -> a
+biminimum = fromMaybe (error "biminimum: empty structure") .
+ getMin . bifoldMap mj mj
+ where mj = Min #. (Just :: a -> Maybe a)
+
+-- | The 'bisum' function computes the sum of the numbers of a structure.
+--
+-- @since 4.10.0.0
+bisum :: (Bifoldable t, Num a) => t a a -> a
+bisum = getSum #. bifoldMap Sum Sum
+
+-- | The 'biproduct' function computes the product of the numbers of a
+-- structure.
+--
+-- @since 4.10.0.0
+biproduct :: (Bifoldable t, Num a) => t a a -> a
+biproduct = getProduct #. bifoldMap Product Product
+
+-- | Given a means of mapping the elements of a structure to lists, computes the
+-- concatenation of all such lists in order.
+--
+-- @since 4.10.0.0
+biconcatMap :: Bifoldable t => (a -> [c]) -> (b -> [c]) -> t a b -> [c]
+biconcatMap = bifoldMap
+
+-- | 'biand' returns the conjunction of a container of Bools. For the
+-- result to be 'True', the container must be finite; 'False', however,
+-- results from a 'False' value finitely far from the left end.
+--
+-- @since 4.10.0.0
+biand :: Bifoldable t => t Bool Bool -> Bool
+biand = getAll #. bifoldMap All All
+
+-- | 'bior' returns the disjunction of a container of Bools. For the
+-- result to be 'False', the container must be finite; 'True', however,
+-- results from a 'True' value finitely far from the left end.
+--
+-- @since 4.10.0.0
+bior :: Bifoldable t => t Bool Bool -> Bool
+bior = getAny #. bifoldMap Any Any
+
+-- | Determines whether any element of the structure satisfies its appropriate
+-- predicate argument.
+--
+-- @since 4.10.0.0
+biany :: Bifoldable t => (a -> Bool) -> (b -> Bool) -> t a b -> Bool
+biany p q = getAny #. bifoldMap (Any . p) (Any . q)
+
+-- | Determines whether all elements of the structure satisfy their appropriate
+-- predicate argument.
+--
+-- @since 4.10.0.0
+biall :: Bifoldable t => (a -> Bool) -> (b -> Bool) -> t a b -> Bool
+biall p q = getAll #. bifoldMap (All . p) (All . q)
+
+-- | The largest element of a non-empty structure with respect to the
+-- given comparison function.
+--
+-- @since 4.10.0.0
+bimaximumBy :: Bifoldable t => (a -> a -> Ordering) -> t a a -> a
+bimaximumBy cmp = bifoldr1 max'
+ where max' x y = case cmp x y of
+ GT -> x
+ _ -> y
+
+-- | The least element of a non-empty structure with respect to the
+-- given comparison function.
+--
+-- @since 4.10.0.0
+biminimumBy :: Bifoldable t => (a -> a -> Ordering) -> t a a -> a
+biminimumBy cmp = bifoldr1 min'
+ where min' x y = case cmp x y of
+ GT -> y
+ _ -> x
+
+-- | 'binotElem' is the negation of 'bielem'.
+--
+-- @since 4.10.0.0
+binotElem :: (Bifoldable t, Eq a) => a -> t a a-> Bool
+binotElem x = not . bielem x
+
+-- | The 'bifind' function takes a predicate and a structure and returns
+-- the leftmost element of the structure matching the predicate, or
+-- 'Nothing' if there is no such element.
+--
+-- @since 4.10.0.0
+bifind :: Bifoldable t => (a -> Bool) -> t a a -> Maybe a
+bifind p = getFirst . bifoldMap finder finder
+ where finder x = First (if p x then Just x else Nothing)
diff --git a/libraries/base/Data/Bitraversable.hs b/libraries/base/Data/Bitraversable.hs
new file mode 100644
index 0000000000..7e64bb55a1
--- /dev/null
+++ b/libraries/base/Data/Bitraversable.hs
@@ -0,0 +1,228 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module : Data.Bitraversable
+-- Copyright : (C) 2011-2016 Edward Kmett
+-- License : BSD-style (see the file LICENSE)
+--
+-- Maintainer : libraries@haskell.org
+-- Stability : provisional
+-- Portability : portable
+--
+-- @since 4.10.0.0
+----------------------------------------------------------------------------
+module Data.Bitraversable
+ ( Bitraversable(..)
+ , bisequenceA
+ , bisequence
+ , bimapM
+ , bifor
+ , biforM
+ , bimapAccumL
+ , bimapAccumR
+ , bimapDefault
+ , bifoldMapDefault
+ ) where
+
+import Control.Applicative
+import Data.Bifunctor
+import Data.Bifoldable
+import Data.Functor.Identity (Identity(..))
+import Data.Functor.Utils (StateL(..), StateR(..))
+import GHC.Generics (K1(..))
+
+-- | 'Bitraversable' identifies bifunctorial data structures whose elements can
+-- be traversed in order, performing 'Applicative' or 'Monad' actions at each
+-- element, and collecting a result structure with the same shape.
+--
+-- As opposed to 'Traversable' data structures, which have one variety of
+-- element on which an action can be performed, 'Bitraversable' data structures
+-- have two such varieties of elements.
+--
+-- A definition of 'traverse' must satisfy the following laws:
+--
+-- [/naturality/]
+-- @'bitraverse' (t . f) (t . g) ≡ t . 'bitraverse' f g@
+-- for every applicative transformation @t@
+--
+-- [/identity/]
+-- @'bitraverse' 'Identity' 'Identity' ≡ 'Identity'@
+--
+-- [/composition/]
+-- @'Compose' . 'fmap' ('bitraverse' g1 g2) . 'bitraverse' f1 f2
+-- ≡ 'traverse' ('Compose' . 'fmap' g1 . f1) ('Compose' . 'fmap' g2 . f2)@
+--
+-- where an /applicative transformation/ is a function
+--
+-- @t :: ('Applicative' f, 'Applicative' g) => f a -> g a@
+--
+-- preserving the 'Applicative' operations:
+--
+-- @
+-- t ('pure' x) = 'pure' x
+-- t (f '<*>' x) = t f '<*>' t x
+-- @
+--
+-- and the identity functor 'Identity' and composition functors 'Compose' are
+-- defined as
+--
+-- > newtype Identity a = Identity { runIdentity :: a }
+-- >
+-- > instance Functor Identity where
+-- > fmap f (Identity x) = Identity (f x)
+-- >
+-- > instance Applicative Identity where
+-- > pure = Identity
+-- > Identity f <*> Identity x = Identity (f x)
+-- >
+-- > newtype Compose f g a = Compose (f (g a))
+-- >
+-- > instance (Functor f, Functor g) => Functor (Compose f g) where
+-- > fmap f (Compose x) = Compose (fmap (fmap f) x)
+-- >
+-- > instance (Applicative f, Applicative g) => Applicative (Compose f g) where
+-- > pure = Compose . pure . pure
+-- > Compose f <*> Compose x = Compose ((<*>) <$> f <*> x)
+--
+-- Some simple examples are 'Either' and '(,)':
+--
+-- > instance Bitraversable Either where
+-- > bitraverse f _ (Left x) = Left <$> f x
+-- > bitraverse _ g (Right y) = Right <$> g y
+-- >
+-- > instance Bitraversable (,) where
+-- > bitraverse f g (x, y) = (,) <$> f x <*> g y
+--
+-- 'Bitraversable' relates to its superclasses in the following ways:
+--
+-- @
+-- 'bimap' f g ≡ 'runIdentity' . 'bitraverse' ('Identity' . f) ('Identity' . g)
+-- 'bifoldMap' f g = 'getConst' . 'bitraverse' ('Const' . f) ('Const' . g)
+-- @
+--
+-- These are available as 'bimapDefault' and 'bifoldMapDefault' respectively.
+--
+-- @since 4.10.0.0
+class (Bifunctor t, Bifoldable t) => Bitraversable t where
+ -- | Evaluates the relevant functions at each element in the structure,
+ -- running the action, and builds a new structure with the same shape, using
+ -- the results produced from sequencing the actions.
+ --
+ -- @'bitraverse' f g ≡ 'bisequenceA' . 'bimap' f g@
+ --
+ -- For a version that ignores the results, see 'bitraverse_'.
+ --
+ -- @since 4.10.0.0
+ bitraverse :: Applicative f => (a -> f c) -> (b -> f d) -> t a b -> f (t c d)
+ bitraverse f g = bisequenceA . bimap f g
+
+-- | Alias for 'bisequence'.
+--
+-- @since 4.10.0.0
+bisequenceA :: (Bitraversable t, Applicative f) => t (f a) (f b) -> f (t a b)
+bisequenceA = bisequence
+
+-- | Alias for 'bitraverse'.
+--
+-- @since 4.10.0.0
+bimapM :: (Bitraversable t, Applicative f)
+ => (a -> f c) -> (b -> f d) -> t a b -> f (t c d)
+bimapM = bitraverse
+
+-- | Sequences all the actions in a structure, building a new structure with
+-- the same shape using the results of the actions. For a version that ignores
+-- the results, see 'sequence_'.
+--
+-- @'bisequence' ≡ 'bitraverse' 'id' 'id'@
+--
+-- @since 4.10.0.0
+bisequence :: (Bitraversable t, Applicative f) => t (f a) (f b) -> f (t a b)
+bisequence = bitraverse id id
+
+-- | @since 4.10.0.0
+instance Bitraversable (,) where
+ bitraverse f g ~(a, b) = (,) <$> f a <*> g b
+
+-- | @since 4.10.0.0
+instance Bitraversable ((,,) x) where
+ bitraverse f g ~(x, a, b) = (,,) x <$> f a <*> g b
+
+-- | @since 4.10.0.0
+instance Bitraversable ((,,,) x y) where
+ bitraverse f g ~(x, y, a, b) = (,,,) x y <$> f a <*> g b
+
+-- | @since 4.10.0.0
+instance Bitraversable ((,,,,) x y z) where
+ bitraverse f g ~(x, y, z, a, b) = (,,,,) x y z <$> f a <*> g b
+
+-- | @since 4.10.0.0
+instance Bitraversable ((,,,,,) x y z w) where
+ bitraverse f g ~(x, y, z, w, a, b) = (,,,,,) x y z w <$> f a <*> g b
+
+-- | @since 4.10.0.0
+instance Bitraversable ((,,,,,,) x y z w v) where
+ bitraverse f g ~(x, y, z, w, v, a, b) = (,,,,,,) x y z w v <$> f a <*> g b
+
+-- | @since 4.10.0.0
+instance Bitraversable Either where
+ bitraverse f _ (Left a) = Left <$> f a
+ bitraverse _ g (Right b) = Right <$> g b
+
+-- | @since 4.10.0.0
+instance Bitraversable Const where
+ bitraverse f _ (Const a) = Const <$> f a
+
+-- | @since 4.10.0.0
+instance Bitraversable (K1 i) where
+ bitraverse f _ (K1 c) = K1 <$> f c
+
+-- | 'bifor' is 'bitraverse' with the structure as the first argument. For a
+-- version that ignores the results, see 'bifor_'.
+--
+-- @since 4.10.0.0
+bifor :: (Bitraversable t, Applicative f)
+ => t a b -> (a -> f c) -> (b -> f d) -> f (t c d)
+bifor t f g = bitraverse f g t
+
+-- | Alias for 'bifor'.
+--
+-- @since 4.10.0.0
+biforM :: (Bitraversable t, Applicative f)
+ => t a b -> (a -> f c) -> (b -> f d) -> f (t c d)
+biforM = bifor
+
+-- | The 'bimapAccumL' function behaves like a combination of 'bimap' and
+-- 'bifoldl'; it traverses a structure from left to right, threading a state
+-- of type @a@ and using the given actions to compute new elements for the
+-- structure.
+--
+-- @since 4.10.0.0
+bimapAccumL :: Bitraversable t => (a -> b -> (a, c)) -> (a -> d -> (a, e))
+ -> a -> t b d -> (a, t c e)
+bimapAccumL f g s t
+ = runStateL (bitraverse (StateL . flip f) (StateL . flip g) t) s
+
+-- | The 'bimapAccumR' function behaves like a combination of 'bimap' and
+-- 'bifoldl'; it traverses a structure from right to left, threading a state
+-- of type @a@ and using the given actions to compute new elements for the
+-- structure.
+--
+-- @since 4.10.0.0
+bimapAccumR :: Bitraversable t => (a -> b -> (a, c)) -> (a -> d -> (a, e))
+ -> a -> t b d -> (a, t c e)
+bimapAccumR f g s t
+ = runStateR (bitraverse (StateR . flip f) (StateR . flip g) t) s
+
+-- | A default definition of 'bimap' in terms of the 'Bitraversable'
+-- operations.
+--
+-- @since 4.10.0.0
+bimapDefault :: Bitraversable t => (a -> b) -> (c -> d) -> t a c -> t b d
+bimapDefault f g = runIdentity . bitraverse (Identity . f) (Identity . g)
+
+-- | A default definition of 'bifoldMap' in terms of the 'Bitraversable'
+-- operations.
+--
+-- @since 4.10.0.0
+bifoldMapDefault :: (Bitraversable t, Monoid m)
+ => (a -> m) -> (b -> m) -> t a b -> m
+bifoldMapDefault f g = getConst . bitraverse (Const . f) (Const . g)
diff --git a/libraries/base/Data/Data.hs b/libraries/base/Data/Data.hs
index 32e3832401..0e40b1759d 100644
--- a/libraries/base/Data/Data.hs
+++ b/libraries/base/Data/Data.hs
@@ -129,6 +129,7 @@ import GHC.Show
import Text.Read( reads )
-- Imports for the instances
+import Data.Functor.Identity -- So we can give Data instance for Identity
import Data.Int -- So we can give Data instance for Int8, ...
import Data.Type.Coercion
import Data.Word -- So we can give Data instance for Word8, ...
@@ -310,14 +311,14 @@ class Typeable a => Data a where
-- isomorphism pair as injection and projection.
gmapT :: (forall b. Data b => b -> b) -> a -> a
- -- Use an identity datatype constructor ID (see below)
+ -- Use the Identity datatype constructor
-- to instantiate the type constructor c in the type of gfoldl,
- -- and perform injections ID and projections unID accordingly.
+ -- and perform injections Identity and projections runIdentity accordingly.
--
- gmapT f x0 = unID (gfoldl k ID x0)
+ gmapT f x0 = runIdentity (gfoldl k Identity x0)
where
- k :: Data d => ID (d->b) -> d -> ID b
- k (ID c) x = ID (c (f x))
+ k :: Data d => Identity (d->b) -> d -> Identity b
+ k (Identity c) x = Identity (c (f x))
-- | A generic query with a left-associative binary operator
@@ -423,10 +424,6 @@ was transformed successfully.
)
--- | The identity type constructor needed for the definition of gmapT
-newtype ID x = ID { unID :: x }
-
-
-- | The constant type constructor needed for the definition of gmapQl
newtype CONST c a = CONST { unCONST :: c }
@@ -461,13 +458,13 @@ fromConstrB :: Data a
=> (forall d. Data d => d)
-> Constr
-> a
-fromConstrB f = unID . gunfold k z
+fromConstrB f = runIdentity . gunfold k z
where
- k :: forall b r. Data b => ID (b -> r) -> ID r
- k c = ID (unID c f)
+ k :: forall b r. Data b => Identity (b -> r) -> Identity r
+ k c = Identity (runIdentity c f)
- z :: forall r. r -> ID r
- z = ID
+ z :: forall r. r -> Identity r
+ z = Identity
-- | Monadic variation on 'fromConstrB'
@@ -1200,6 +1197,9 @@ deriving instance (a ~ b, Data a) => Data (a :~: b)
-- | @since 4.7.0.0
deriving instance (Coercible a b, Data a, Data b) => Data (Coercion a b)
+-- | @since 4.9.0.0
+deriving instance Data a => Data (Identity a)
+
-- | @since 4.7.0.0
deriving instance Data Version
diff --git a/libraries/base/Data/Foldable.hs b/libraries/base/Data/Foldable.hs
index 7443117cac..6ad549f0fe 100644
--- a/libraries/base/Data/Foldable.hs
+++ b/libraries/base/Data/Foldable.hs
@@ -54,6 +54,7 @@ module Data.Foldable (
import Data.Bool
import Data.Either
import Data.Eq
+import Data.Functor.Utils (Max(..), Min(..), (#.))
import qualified GHC.List as List
import Data.Maybe
import Data.Monoid
@@ -406,37 +407,6 @@ instance Foldable First where
instance Foldable Last where
foldMap f = foldMap f . getLast
--- We don't export Max and Min because, as Edward Kmett pointed out to me,
--- there are two reasonable ways to define them. One way is to use Maybe, as we
--- do here; the other way is to impose a Bounded constraint on the Monoid
--- instance. We may eventually want to add both versions, but we don't want to
--- trample on anyone's toes by imposing Max = MaxMaybe.
-
-newtype Max a = Max {getMax :: Maybe a}
-newtype Min a = Min {getMin :: Maybe a}
-
--- | @since 4.8.0.0
-instance Ord a => Monoid (Max a) where
- mempty = Max Nothing
-
- {-# INLINE mappend #-}
- m `mappend` Max Nothing = m
- Max Nothing `mappend` n = n
- (Max m@(Just x)) `mappend` (Max n@(Just y))
- | x >= y = Max m
- | otherwise = Max n
-
--- | @since 4.8.0.0
-instance Ord a => Monoid (Min a) where
- mempty = Min Nothing
-
- {-# INLINE mappend #-}
- m `mappend` Min Nothing = m
- Min Nothing `mappend` n = n
- (Min m@(Just x)) `mappend` (Min n@(Just y))
- | x <= y = Min m
- | otherwise = Min n
-
-- Instances for GHC.Generics
-- | @since 4.9.0.0
instance Foldable U1 where
@@ -603,35 +573,3 @@ notElem x = not . elem x
-- 'Nothing' if there is no such element.
find :: Foldable t => (a -> Bool) -> t a -> Maybe a
find p = getFirst . foldMap (\ x -> First (if p x then Just x else Nothing))
-
--- See Note [Function coercion]
-(#.) :: Coercible b c => (b -> c) -> (a -> b) -> (a -> c)
-(#.) _f = coerce
-{-# INLINE (#.) #-}
-
-{-
-Note [Function coercion]
-~~~~~~~~~~~~~~~~~~~~~~~~
-
-Several functions here use (#.) instead of (.) to avoid potential efficiency
-problems relating to #7542. The problem, in a nutshell:
-
-If N is a newtype constructor, then N x will always have the same
-representation as x (something similar applies for a newtype deconstructor).
-However, if f is a function,
-
-N . f = \x -> N (f x)
-
-This looks almost the same as f, but the eta expansion lifts it--the lhs could
-be _|_, but the rhs never is. This can lead to very inefficient code. Thus we
-steal a technique from Shachaf and Edward Kmett and adapt it to the current
-(rather clean) setting. Instead of using N . f, we use N .## f, which is
-just
-
-coerce f `asTypeOf` (N . f)
-
-That is, we just *pretend* that f has the right type, and thanks to the safety
-of coerce, the type checker guarantees that nothing really goes wrong. We still
-have to be a bit careful, though: remember that #. completely ignores the
-*value* of its left operand.
--}
diff --git a/libraries/base/Data/Functor/Identity.hs b/libraries/base/Data/Functor/Identity.hs
index 1adfaebeff..492ba84600 100644
--- a/libraries/base/Data/Functor/Identity.hs
+++ b/libraries/base/Data/Functor/Identity.hs
@@ -2,6 +2,7 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE Trustworthy #-}
-----------------------------------------------------------------------------
@@ -35,24 +36,30 @@ module Data.Functor.Identity (
) where
import Control.Monad.Fix
-import Control.Monad.Zip
import Data.Bits (Bits, FiniteBits)
import Data.Coerce
-import Data.Data (Data)
import Data.Foldable
-import Data.Ix (Ix)
-import Data.Semigroup (Semigroup)
-import Data.String (IsString)
+import Data.Functor.Utils ((#.))
import Foreign.Storable (Storable)
+import GHC.Arr (Ix)
+import GHC.Base ( Applicative(..), Eq(..), Functor(..), Monad(..)
+ , Monoid, Ord(..), ($), (.) )
+import GHC.Enum (Bounded, Enum)
+import GHC.Float (Floating, RealFloat)
import GHC.Generics (Generic, Generic1)
+import GHC.Num (Num)
+import GHC.Read (Read(..), lex, readParen)
+import GHC.Real (Fractional, Integral, Real, RealFrac)
+import GHC.Show (Show(..), showParen, showString)
+import GHC.Types (Bool(..))
-- | Identity functor and monad. (a non-strict monad)
--
-- @since 4.8.0.0
newtype Identity a = Identity { runIdentity :: a }
- deriving ( Bits, Bounded, Data, Enum, Eq, FiniteBits, Floating, Fractional
- , Generic, Generic1, Integral, IsString, Ix, Monoid, Num, Ord
- , Real, RealFrac, RealFloat , Semigroup, Storable, Traversable)
+ deriving ( Bits, Bounded, Enum, Eq, FiniteBits, Floating, Fractional
+ , Generic, Generic1, Integral, Ix, Monoid, Num, Ord
+ , Real, RealFrac, RealFloat, Storable)
-- | This instance would be equivalent to the derived instances of the
-- 'Identity' newtype if the 'runIdentity' field were removed
@@ -108,14 +115,3 @@ instance Monad Identity where
-- | @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
-
--- | Internal (non-exported) 'Coercible' helper for 'elem'
---
--- See Note [Function coercion] in "Data.Foldable" for more details.
-(#.) :: Coercible b c => (b -> c) -> (a -> b) -> a -> c
-(#.) _f = coerce
diff --git a/libraries/base/Data/Functor/Utils.hs b/libraries/base/Data/Functor/Utils.hs
new file mode 100644
index 0000000000..e24d235894
--- /dev/null
+++ b/libraries/base/Data/Functor/Utils.hs
@@ -0,0 +1,106 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-----------------------------------------------------------------------------
+-- This is a non-exposed internal module.
+--
+-- This code contains utility function and data structures that are used
+-- to improve the efficiency of several instances in the Data.* namespace.
+-----------------------------------------------------------------------------
+module Data.Functor.Utils where
+
+import Data.Coerce (Coercible, coerce)
+import GHC.Base ( Applicative(..), Functor(..), Maybe(..), Monoid(..), Ord(..)
+ , ($), otherwise )
+
+-- We don't expose Max and Min because, as Edward Kmett pointed out to me,
+-- there are two reasonable ways to define them. One way is to use Maybe, as we
+-- do here; the other way is to impose a Bounded constraint on the Monoid
+-- instance. We may eventually want to add both versions, but we don't want to
+-- trample on anyone's toes by imposing Max = MaxMaybe.
+
+newtype Max a = Max {getMax :: Maybe a}
+newtype Min a = Min {getMin :: Maybe a}
+
+-- | @since 4.8.0.0
+instance Ord a => Monoid (Max a) where
+ mempty = Max Nothing
+
+ {-# INLINE mappend #-}
+ m `mappend` Max Nothing = m
+ Max Nothing `mappend` n = n
+ (Max m@(Just x)) `mappend` (Max n@(Just y))
+ | x >= y = Max m
+ | otherwise = Max n
+
+-- | @since 4.8.0.0
+instance Ord a => Monoid (Min a) where
+ mempty = Min Nothing
+
+ {-# INLINE mappend #-}
+ m `mappend` Min Nothing = m
+ Min Nothing `mappend` n = n
+ (Min m@(Just x)) `mappend` (Min n@(Just y))
+ | x <= y = Min m
+ | otherwise = Min n
+
+-- left-to-right state transformer
+newtype StateL s a = StateL { runStateL :: s -> (s, a) }
+
+-- | @since 4.0
+instance Functor (StateL s) where
+ fmap f (StateL k) = StateL $ \ s -> let (s', v) = k s in (s', f v)
+
+-- | @since 4.0
+instance Applicative (StateL s) where
+ pure x = StateL (\ s -> (s, x))
+ StateL kf <*> StateL kv = StateL $ \ s ->
+ let (s', f) = kf s
+ (s'', v) = kv s'
+ in (s'', f v)
+
+-- right-to-left state transformer
+newtype StateR s a = StateR { runStateR :: s -> (s, a) }
+
+-- | @since 4.0
+instance Functor (StateR s) where
+ fmap f (StateR k) = StateR $ \ s -> let (s', v) = k s in (s', f v)
+
+-- | @since 4.0
+instance Applicative (StateR s) where
+ pure x = StateR (\ s -> (s, x))
+ StateR kf <*> StateR kv = StateR $ \ s ->
+ let (s', v) = kv s
+ (s'', f) = kf s'
+ in (s'', f v)
+
+-- See Note [Function coercion]
+(#.) :: Coercible b c => (b -> c) -> (a -> b) -> (a -> c)
+(#.) _f = coerce
+{-# INLINE (#.) #-}
+
+{-
+Note [Function coercion]
+~~~~~~~~~~~~~~~~~~~~~~~
+
+Several functions here use (#.) instead of (.) to avoid potential efficiency
+problems relating to #7542. The problem, in a nutshell:
+
+If N is a newtype constructor, then N x will always have the same
+representation as x (something similar applies for a newtype deconstructor).
+However, if f is a function,
+
+N . f = \x -> N (f x)
+
+This looks almost the same as f, but the eta expansion lifts it--the lhs could
+be _|_, but the rhs never is. This can lead to very inefficient code. Thus we
+steal a technique from Shachaf and Edward Kmett and adapt it to the current
+(rather clean) setting. Instead of using N . f, we use N #. f, which is
+just
+
+coerce f `asTypeOf` (N . f)
+
+That is, we just *pretend* that f has the right type, and thanks to the safety
+of coerce, the type checker guarantees that nothing really goes wrong. We still
+have to be a bit careful, though: remember that #. completely ignores the
+*value* of its left operand.
+-}
diff --git a/libraries/base/Data/Semigroup.hs b/libraries/base/Data/Semigroup.hs
index 24237a7877..63d42854c0 100644
--- a/libraries/base/Data/Semigroup.hs
+++ b/libraries/base/Data/Semigroup.hs
@@ -1,11 +1,12 @@
-{-# LANGUAGE DefaultSignatures #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE PolyKinds #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE TypeOperators #-}
-----------------------------------------------------------------------------
-- |
@@ -70,9 +71,12 @@ import Prelude hiding (foldr1)
import Control.Applicative
import Control.Monad
import Control.Monad.Fix
+import Data.Bifoldable
import Data.Bifunctor
+import Data.Bitraversable
import Data.Coerce
import Data.Data
+import Data.Functor.Identity
import Data.List.NonEmpty
import Data.Monoid (All (..), Any (..), Dual (..), Endo (..),
Product (..), Sum (..))
@@ -280,6 +284,11 @@ stimesIdempotent n x
| otherwise = x
-- | @since 4.9.0.0
+instance Semigroup a => Semigroup (Identity a) where
+ (<>) = coerce ((<>) :: a -> a -> a)
+ stimes n (Identity a) = Identity (stimes n a)
+
+-- | @since 4.9.0.0
instance Semigroup a => Semigroup (Const a b) where
(<>) = coerce ((<>) :: a -> a -> a)
stimes n (Const a) = Const (stimes n a)
@@ -474,6 +483,12 @@ instance Ord a => Ord (Arg a b) where
instance Bifunctor Arg where
bimap f g (Arg a b) = Arg (f a) (g b)
+instance Bifoldable Arg where
+ bifoldMap f g (Arg a b) = f a `mappend` g b
+
+instance Bitraversable Arg where
+ bitraverse f g (Arg a b) = Arg <$> f a <*> g b
+
-- | Use @'Option' ('First' a)@ to get the behavior of
-- 'Data.Monoid.First' from "Data.Monoid".
newtype First a = First { getFirst :: a } deriving
diff --git a/libraries/base/Data/String.hs b/libraries/base/Data/String.hs
index db2f510b6a..e9f34a82a9 100644
--- a/libraries/base/Data/String.hs
+++ b/libraries/base/Data/String.hs
@@ -1,5 +1,8 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE NoImplicitPrelude, FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
-----------------------------------------------------------------------------
@@ -29,6 +32,7 @@ module Data.String (
import GHC.Base
import Data.Functor.Const (Const (Const))
+import Data.Functor.Identity (Identity (Identity))
import Data.List (lines, words, unlines, unwords)
-- | Class for string-like datastructures; used by the overloaded string
@@ -83,5 +87,5 @@ instance (a ~ Char) => IsString [a] where
fromString xs = xs
-- | @since 4.9.0.0
-instance IsString a => IsString (Const a b) where
- fromString = Const . fromString
+deriving instance IsString a => IsString (Const a b)
+deriving instance IsString a => IsString (Identity a)
diff --git a/libraries/base/Data/Traversable.hs b/libraries/base/Data/Traversable.hs
index 72e2dfd57f..6f503b7dbe 100644
--- a/libraries/base/Data/Traversable.hs
+++ b/libraries/base/Data/Traversable.hs
@@ -56,6 +56,8 @@ import Control.Applicative ( Const(..), ZipList(..) )
import Data.Either ( Either(..) )
import Data.Foldable ( Foldable )
import Data.Functor
+import Data.Functor.Identity ( Identity(..) )
+import Data.Functor.Utils ( StateL(..), StateR(..) )
import Data.Monoid ( Dual(..), Sum(..), Product(..), First(..), Last(..) )
import Data.Proxy ( Proxy(..) )
@@ -240,6 +242,8 @@ instance Traversable Last where
instance Traversable ZipList where
traverse f (ZipList x) = ZipList <$> traverse f x
+deriving instance Traversable Identity
+
-- Instances for GHC.Generics
-- | @since 4.9.0.0
instance Traversable U1 where
@@ -281,21 +285,6 @@ forM :: (Traversable t, Monad m) => t a -> (a -> m b) -> m (t b)
{-# INLINE forM #-}
forM = flip mapM
--- left-to-right state transformer
-newtype StateL s a = StateL { runStateL :: s -> (s, a) }
-
--- | @since 4.0
-instance Functor (StateL s) where
- fmap f (StateL k) = StateL $ \ s -> let (s', v) = k s in (s', f v)
-
--- | @since 4.0
-instance Applicative (StateL s) where
- pure x = StateL (\ s -> (s, x))
- StateL kf <*> StateL kv = StateL $ \ s ->
- let (s', f) = kf s
- (s'', v) = kv s'
- in (s'', f v)
-
-- |The 'mapAccumL' function behaves like a combination of 'fmap'
-- and 'foldl'; it applies a function to each element of a structure,
-- passing an accumulating parameter from left to right, and returning
@@ -303,21 +292,6 @@ instance Applicative (StateL s) where
mapAccumL :: Traversable t => (a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL f s t = runStateL (traverse (StateL . flip f) t) s
--- right-to-left state transformer
-newtype StateR s a = StateR { runStateR :: s -> (s, a) }
-
--- | @since 4.0
-instance Functor (StateR s) where
- fmap f (StateR k) = StateR $ \ s -> let (s', v) = k s in (s', f v)
-
--- | @since 4.0
-instance Applicative (StateR s) where
- pure x = StateR (\ s -> (s, x))
- StateR kf <*> StateR kv = StateR $ \ s ->
- let (s', v) = kv s
- (s'', f) = kf s'
- in (s'', f v)
-
-- |The 'mapAccumR' function behaves like a combination of 'fmap'
-- and 'foldr'; it applies a function to each element of a structure,
-- passing an accumulating parameter from right to left, and returning
@@ -331,23 +305,9 @@ mapAccumR f s t = runStateR (traverse (StateR . flip f) t) s
-- 'sequenceA' will result in infinite recursion.)
fmapDefault :: Traversable t => (a -> b) -> t a -> t b
{-# INLINE fmapDefault #-}
-fmapDefault f = getId . traverse (Id . f)
+fmapDefault f = runIdentity . traverse (Identity . f)
-- | This function may be used as a value for `Data.Foldable.foldMap`
-- in a `Foldable` instance.
foldMapDefault :: (Traversable t, Monoid m) => (a -> m) -> t a -> m
foldMapDefault f = getConst . traverse (Const . f)
-
--- local instances
-
-newtype Id a = Id { getId :: a }
-
--- | @since 2.01
-instance Functor Id where
- fmap f (Id x) = Id (f x)
-
--- | @since 2.01
-instance Applicative Id where
- pure = Id
- Id f <*> Id x = Id (f x)
-
diff --git a/libraries/base/base.cabal b/libraries/base/base.cabal
index e068bbc9a1..cf122f7f9e 100644
--- a/libraries/base/base.cabal
+++ b/libraries/base/base.cabal
@@ -130,7 +130,9 @@ Library
Control.Monad.ST.Strict
Control.Monad.ST.Unsafe
Control.Monad.Zip
+ Data.Bifoldable
Data.Bifunctor
+ Data.Bitraversable
Data.Bits
Data.Bool
Data.Char
@@ -307,6 +309,7 @@ Library
other-modules:
Control.Monad.ST.Imp
Control.Monad.ST.Lazy.Imp
+ Data.Functor.Utils
Data.OldList
Foreign.ForeignPtr.Imp
System.Environment.ExecutablePath
diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md
index 4cb2533e74..3b44ded468 100644
--- a/libraries/base/changelog.md
+++ b/libraries/base/changelog.md
@@ -9,6 +9,9 @@
* `Generic1`, as well as the associated datatypes and typeclasses in
`GHC.Generics`, are now poly-kinded (#10604)
+ * `New modules `Data.Bifoldable` and `Data.Bitraversable` (previously defined
+ in the `bifunctors` package) (#10448)
+
## 4.9.0.0 *TBA*
* Bundled with GHC 8.0
diff --git a/testsuite/tests/annotations/should_fail/annfail10.stderr b/testsuite/tests/annotations/should_fail/annfail10.stderr
index b5f5a16fdf..6782f27228 100644
--- a/testsuite/tests/annotations/should_fail/annfail10.stderr
+++ b/testsuite/tests/annotations/should_fail/annfail10.stderr
@@ -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 38 instances involving out-of-scope types
+ ...plus 39 instances involving out-of-scope types
(use -fprint-potential-instances to see them all)
• In the annotation: {-# ANN f 1 #-}
@@ -23,6 +23,6 @@ annfail10.hs:9:11: error:
instance Num Double -- Defined in ‘GHC.Float’
instance Num Float -- Defined in ‘GHC.Float’
...plus two others
- ...plus 12 instances involving out-of-scope types
+ ...plus 13 instances involving out-of-scope types
(use -fprint-potential-instances to see them all)
• In the annotation: {-# ANN f 1 #-}
diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T
index 7435a3330f..a09499915a 100644
--- a/testsuite/tests/perf/compiler/all.T
+++ b/testsuite/tests/perf/compiler/all.T
@@ -776,9 +776,10 @@ test('T9961',
test('T9233',
[ only_ways(['normal']),
compiler_stats_num_field('bytes allocated',
- [(wordsize(64), 1066246248, 5),
+ [(wordsize(64), 984268712, 5),
# 2015-08-04 999826288 initial value
# 2016-04-14 1066246248 Final demand analyzer run
+ # 2016-06-18 984268712 shuffling around of Data.Functor.Identity
(wordsize(32), 515672240, 5) # Put in your value here if you hit this
# 2016-04-06 515672240 (x86/Linux) initial value
]),
diff --git a/testsuite/tests/typecheck/should_fail/T10971b.stderr b/testsuite/tests/typecheck/should_fail/T10971b.stderr
index d072c2552b..2e63617464 100644
--- a/testsuite/tests/typecheck/should_fail/T10971b.stderr
+++ b/testsuite/tests/typecheck/should_fail/T10971b.stderr
@@ -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 24 instances involving out-of-scope types
+ ...plus 25 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 24 instances involving out-of-scope types
+ ...plus 25 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 24 instances involving out-of-scope types
+ ...plus 25 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 24 instances involving out-of-scope types
+ ...plus 25 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)