Add Bifoldable and Bitraversable to base
authorRyan Scott <ryan.gl.scott@gmail.com>
Sat, 18 Jun 2016 10:17:24 +0000 (12:17 +0200)
committerBen Gamari <ben@smart-cactus.org>
Sat, 18 Jun 2016 22:27:06 +0000 (00:27 +0200)
This adds `Data.Bifoldable` and `Data.Bitraversable` from the
`bifunctors` package to `base`, completing the migration started in
D336.  This is fairly straightforward, although there were a suprising
amount of reinternal organization in `base` that was needed for this to
happen:

* `Data.Foldable`, `Data.Traversable`, `Data.Bifoldable`, and
  `Data.Bitraversable` share some nonexported datatypes (e.g., `StateL`,
  `StateR`, `Min`, `Max`, etc.) to implement some instances. To avoid
  code duplication, I migrated this internal code to a new hidden
  module, `Data.Functor.Utils` (better naming suggestions welcome).

* `Data.Traversable` and `Data.Bitraversable` also make use of an
  identity newtype, so I modified them to use
  `Data.Functor.Identity.Identity`. This has a ripple effect on several
  other modules, since I had to move instances around in order to avoid
  dependency cycles.

Fixes #10448.

Reviewers: ekmett, hvr, austin, bgamari

Reviewed By: bgamari

Subscribers: thomie

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

GHC Trac Issues: #9682, #10448

15 files changed:
libraries/base/Control/Monad/Zip.hs
libraries/base/Data/Bifoldable.hs [new file with mode: 0644]
libraries/base/Data/Bitraversable.hs [new file with mode: 0644]
libraries/base/Data/Data.hs
libraries/base/Data/Foldable.hs
libraries/base/Data/Functor/Identity.hs
libraries/base/Data/Functor/Utils.hs [new file with mode: 0644]
libraries/base/Data/Semigroup.hs
libraries/base/Data/String.hs
libraries/base/Data/Traversable.hs
libraries/base/base.cabal
libraries/base/changelog.md
testsuite/tests/annotations/should_fail/annfail10.stderr
testsuite/tests/perf/compiler/all.T
testsuite/tests/typecheck/should_fail/T10971b.stderr

index f102ff0..5b67008 100644 (file)
@@ -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 (file)
index 0000000..11a1c25
--- /dev/null
@@ -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 (file)
index 0000000..7e64bb5
--- /dev/null
@@ -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)
index 32e3832..0e40b17 100644 (file)
@@ -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
 
index 7443117..6ad549f 100644 (file)
@@ -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.
--}
index 1adfaeb..492ba84 100644 (file)
@@ -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 (file)
index 0000000..e24d235
--- /dev/null
@@ -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.
+-}
index 24237a7..63d4285 100644 (file)
@@ -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
index db2f510..e9f34a8 100644 (file)
@@ -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)
index 72e2dfd..6f503b7 100644 (file)
@@ -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)
-
index e068bbc..cf122f7 100644 (file)
@@ -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
index 4cb2533..3b44ded 100644 (file)
@@ -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
index b5f5a16..6782f27 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 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 #-}
index 7435a33..a094999 100644 (file)
@@ -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
         ]),
index d072c25..2e63617 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 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)