bifunctors 5.3 → 5.4

raw patch · 12 files changed

+1159/−978 lines, 12 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• .travis.yml +85/−23
• CHANGELOG.markdown +5/−0
• bifunctors.cabal +8/−4
• old-src/Data/Bifunctor.hs +0/−187
• old-src/ghc709/Data/Bifunctor.hs +187/−0
• old-src/ghc801/Data/Bifoldable.hs +490/−0
• old-src/ghc801/Data/Bitraversable.hs +312/−0
• src/Data/Bifoldable.hs +0/−422
• src/Data/Bifunctor/TH.hs +33/−25
• src/Data/Bifunctor/TH/Internal.hs +37/−15
• src/Data/Bitraversable.hs +0/−299
• tests/BifunctorSpec.hs +2/−3

@@ -1,36 +1,96 @@-env:- - GHCVER=7.0.4 CABALVER=1.18- - GHCVER=7.2.2 CABALVER=1.18- - GHCVER=7.4.2 CABALVER=1.18- - GHCVER=7.6.3 CABALVER=1.18- - GHCVER=7.8.4 CABALVER=1.18- - GHCVER=7.10.3 CABALVER=1.22- - GHCVER=8.0.1 CABALVER=1.24- - GHCVER=head CABALVER=1.24+# This file has been generated -- see https://github.com/hvr/multi-ghc-travis+language: c+sudo: false +cache:+  directories:+    - $HOME/.cabsnap+    - $HOME/.cabal/packages++before_cache:+  - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log+  - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.tar+ matrix:+  include:+    - env: CABALVER=1.18 GHCVER=7.0.4+      compiler: ": #GHC 7.0.4"+      addons: {apt: {packages: [cabal-install-1.18,ghc-7.0.4], sources: [hvr-ghc]}}+    - env: CABALVER=1.18 GHCVER=7.2.2+      compiler: ": #GHC 7.2.2"+      addons: {apt: {packages: [cabal-install-1.18,ghc-7.2.2], sources: [hvr-ghc]}}+    - env: CABALVER=1.18 GHCVER=7.4.2+      compiler: ": #GHC 7.4.2"+      addons: {apt: {packages: [cabal-install-1.18,ghc-7.4.2], sources: [hvr-ghc]}}+    - env: CABALVER=1.18 GHCVER=7.6.3+      compiler: ": #GHC 7.6.3"+      addons: {apt: {packages: [cabal-install-1.18,ghc-7.6.3], sources: [hvr-ghc]}}+    - env: CABALVER=1.18 GHCVER=7.8.4+      compiler: ": #GHC 7.8.4"+      addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}}+    - env: CABALVER=1.22 GHCVER=7.10.3+      compiler: ": #GHC 7.10.3"+      addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3], sources: [hvr-ghc]}}+    - env: CABALVER=1.24 GHCVER=8.0.1+      compiler: ": #GHC 8.0.1"+      addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.1], sources: [hvr-ghc]}}+    - env: CABALVER=head GHCVER=head+      compiler: ": #GHC head"+      addons: {apt: {packages: [cabal-install-head,ghc-head], sources: [hvr-ghc]}}+   allow_failures:-   - env: GHCVER=head CABALVER=1.24-   - env: GHCVER=7.0.4 CABALVER=1.18-   - env: GHCVER=7.2.2 CABALVER=1.18+    - env: CABALVER=1.18 GHCVER=7.0.4+    - env: CABALVER=1.18 GHCVER=7.2.2+    - env: CABALVER=head GHCVER=head  before_install:- - travis_retry sudo add-apt-repository -y ppa:hvr/ghc- - travis_retry sudo apt-get update- - travis_retry sudo apt-get install cabal-install-$CABALVER ghc-$GHCVER- - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH- - cabal --version+ - unset CC+ - export PATH=$HOME/.cabal/bin:/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH  install:- - travis_retry cabal update- - cabal install --enable-tests --only-dependencies- - export PATH=$HOME/.cabal/bin:$PATH # Needed to be able to find hspec-discover+ - cabal --version+ - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"+ - if [ -f $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz ];+   then+     zcat $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz >+          $HOME/.cabal/packages/hackage.haskell.org/00-index.tar;+   fi+ - travis_retry cabal update -v+ - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config+ - cabal install --only-dependencies --enable-tests --dry -v > installplan.txt+ - sed -i -e '1,/^Resolving /d' installplan.txt; cat installplan.txt +# check whether current requested install-plan matches cached package-db snapshot+ - if diff -u installplan.txt $HOME/.cabsnap/installplan.txt;+   then+     echo "cabal build-cache HIT";+     rm -rfv .ghc;+     cp -a $HOME/.cabsnap/ghc $HOME/.ghc;+     cp -a $HOME/.cabsnap/lib $HOME/.cabsnap/share $HOME/.cabsnap/bin $HOME/.cabal/;+   else+     echo "cabal build-cache MISS";+     rm -rf $HOME/.cabsnap;+     mkdir -p $HOME/.ghc $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin;+     cabal install -j --only-dependencies --enable-tests;+   fi++# snapshot package-db on cache miss+ - if [ ! -d $HOME/.cabsnap ];+   then+      echo "snapshotting package-db to build-cache";+      mkdir $HOME/.cabsnap;+      cp -a $HOME/.ghc $HOME/.cabsnap/ghc;+      cp -a $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin installplan.txt $HOME/.cabsnap/;+   fi++# Here starts the actual work to be performed for the package under test;+# any command which exits with a non-zero exit code causes the build to fail. script:- - cabal configure -v2 --enable-tests- - cabal build+ - cabal configure -v2 --enable-tests  # -v2 provides useful information for debugging+ - cabal build # this builds all libraries and executables (including tests/benchmarks)  - cabal test --show-details=always- - cabal sdist+ - cabal haddock+ - cabal sdist   # tests that a source-distribution can be generated  - export SRC_TGZ=$(cabal info . | awk '{print $2 ".tar.gz";exit}') ;    cd dist/;    if [ -f "$SRC_TGZ" ]; then@@ -47,3 +107,5 @@     skip_join: true     template:       - "\x0313bifunctors\x0f/\x0306%{branch}\x0f \x0314%{commit}\x0f %{message} \x0302\x1f%{build_url}\x0f"++# EOF

@@ -1,3 +1,8 @@+5.4+---+* Only export `Data.Bifoldable` and `Data.Bitraversable` when building on GHC < 8.1, otherwise they come from `base`+* Allow TH derivation of `Bifunctor` and `Bifoldable` instances for datatypes containing unboxed tuple types+ 5.3 --- * Added `bifoldr1`, `bifoldl1`, `bimsum`, `biasum`, `binull`, `bilength`, `bielem`, `bimaximum`, `biminimum`, `bisum`, `biproduct`, `biand`, `bior`, `bimaximumBy`, `biminimumBy`, `binotElem`, and `bifind` to `Data.Bifoldable`

@@ -1,6 +1,6 @@ name:          bifunctors category:      Data, Functors-version:       5.3+version:       5.4 license:       BSD3 cabal-version: >= 1.8 license-file:  LICENSE@@ -54,15 +54,20 @@     build-depends: semigroups >= 0.8.3.1 && < 1    if impl(ghc<7.9)-    hs-source-dirs: old-src+    hs-source-dirs: old-src/ghc709     exposed-modules: Data.Bifunctor +  if impl(ghc<8.1)+    hs-source-dirs: old-src/ghc801+    exposed-modules:+      Data.Bifoldable+      Data.Bitraversable+   if impl(ghc>=7.2) && impl(ghc<7.5)     build-depends: ghc-prim == 0.2.0.0    exposed-modules:     Data.Biapplicative-    Data.Bifoldable     Data.Bifunctor.Biff     Data.Bifunctor.Clown     Data.Bifunctor.Fix@@ -75,7 +80,6 @@     Data.Bifunctor.Tannen     Data.Bifunctor.TH     Data.Bifunctor.Wrapped-    Data.Bitraversable    other-modules:     Data.Bifunctor.TH.Internal

@@ -1,187 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE StandaloneDeriving #-}--#ifndef MIN_VERSION_semigroups-#define MIN_VERSION_semigroups(x,y,z) 0-#endif--------------------------------------------------------------------------------- |--- Copyright   :  (C) 2008-2015 Edward Kmett--- License     :  BSD-style (see the file LICENSE)------ Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  provisional--- Portability :  portable---------------------------------------------------------------------------------module Data.Bifunctor-  ( -- * Overview-    ---    -- Bifunctors extend the standard 'Functor' to two arguments--    -- * Examples-    -- $examples-    Bifunctor(..)-  ) where--import Control.Applicative-import Data.Functor.Constant--#if MIN_VERSION_semigroups(0,16,2)-import Data.Semigroup-#endif--#ifdef MIN_VERSION_tagged-import Data.Tagged-#endif--#if __GLASGOW_HASKELL__ >= 702-import GHC.Generics (K1(..))-#endif--#if __GLASGOW_HASKELL__ >= 708-import Data.Typeable-#endif---- | Minimal definition either 'bimap' or 'first' and 'second'---- | Formally, the class 'Bifunctor' represents a bifunctor--- from @Hask@ -> @Hask@.------ Intuitively it is a bifunctor where both the first and second arguments are covariant.------ You can define a 'Bifunctor' by either defining 'bimap' or by defining both--- 'first' and 'second'.------ If you supply 'bimap', you should ensure that:------ @'bimap' 'id' 'id' ≡ 'id'@------ If you supply 'first' and 'second', ensure:------ @--- 'first' 'id' ≡ 'id'--- 'second' 'id' ≡ 'id'--- @------ If you supply both, you should also ensure:------ @'bimap' f g ≡ 'first' f '.' 'second' g@------ These ensure by parametricity:------ @--- 'bimap'  (f '.' g) (h '.' i) ≡ 'bimap' f h '.' 'bimap' g i--- 'first'  (f '.' g) ≡ 'first'  f '.' 'first'  g--- 'second' (f '.' g) ≡ 'second' f '.' 'second' g--- @-class Bifunctor p where-  -- | Map over both arguments at the same time.-  ---  -- @'bimap' f g ≡ 'first' f '.' 'second' g@-  bimap :: (a -> b) -> (c -> d) -> p a c -> p b d-  bimap f g = first f . second g-  {-# INLINE bimap #-}--  -- | Map covariantly over the first argument.-  ---  -- @'first' f ≡ 'bimap' f 'id'@-  first :: (a -> b) -> p a c -> p b c-  first f = bimap f id-  {-# INLINE first #-}--  -- | Map covariantly over the second argument.-  ---  -- @'second' ≡ 'bimap' 'id'@-  second :: (b -> c) -> p a b -> p a c-  second = bimap id-  {-# INLINE second #-}--#if __GLASGOW_HASKELL__ >= 708-  {-# MINIMAL bimap | first, second #-}-#endif--#if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 710-deriving instance Typeable Bifunctor-#endif--instance Bifunctor (,) where-  bimap f g ~(a, b) = (f a, g b)-  {-# INLINE bimap #-}--#if MIN_VERSION_semigroups(0,16,2)-instance Bifunctor Arg where-  bimap f g (Arg a b) = Arg (f a) (g b)-#endif--instance Bifunctor ((,,) x) where-  bimap f g ~(x, a, b) = (x, f a, g b)-  {-# INLINE bimap #-}--instance Bifunctor ((,,,) x y) where-  bimap f g ~(x, y, a, b) = (x, y, f a, g b)-  {-# INLINE bimap #-}--instance Bifunctor ((,,,,) x y z) where-  bimap f g ~(x, y, z, a, b) = (x, y, z, f a, g b)-  {-# INLINE bimap #-}--instance Bifunctor ((,,,,,) x y z w) where-  bimap f g ~(x, y, z, w, a, b) = (x, y, z, w, f a, g b)-  {-# INLINE bimap #-}--instance Bifunctor ((,,,,,,) x y z w v) where-  bimap f g ~(x, y, z, w, v, a, b) = (x, y, z, w, v, f a, g b)-  {-# INLINE bimap #-}--instance Bifunctor Either where-  bimap f _ (Left a) = Left (f a)-  bimap _ g (Right b) = Right (g b)-  {-# INLINE bimap #-}--instance Bifunctor Const where-  bimap f _ (Const a) = Const (f a)-  {-# INLINE bimap #-}--instance Bifunctor Constant where-  bimap f _ (Constant a) = Constant (f a)-  {-# INLINE bimap #-}--#if __GLASGOW_HASKELL__ >= 702-instance Bifunctor (K1 i) where-  bimap f _ (K1 c) = K1 (f c)-  {-# INLINE bimap #-}-#endif--#ifdef MIN_VERSION_tagged-instance Bifunctor Tagged where-  bimap _ g (Tagged b) = Tagged (g b)-  {-# INLINE bimap #-}-#endif---- $examples------ ==== __Examples__------ While the standard 'Functor' instance for 'Either' is limited to mapping over 'Right' arguments,--- the 'Bifunctor' instance allows mapping over the 'Left', 'Right', or both arguments:------ > let x = Left "foo" :: Either String Integer------ In the case of 'first' and 'second', the function may or may not be applied:------ > first (++ "bar") x == Left "foobar"--- > second (+2) x      == Left "foo"------ In the case of 'bimap', only one of the functions will be applied:------ > bimap (++ "bar") (+2) x == Left "foobar"------ The 'Bifunctor' instance for 2 element tuples allows mapping over one or both of the elements:------ > let x = ("foo",1)--- >--- > first  (++ "bar") x      == ("foobar", 1)--- > second (+2) x            == ("foo", 3)--- > bimap  (++ "bar") (+2) x == ("foobar", 3)

@@ -0,0 +1,187 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE StandaloneDeriving #-}++#ifndef MIN_VERSION_semigroups+#define MIN_VERSION_semigroups(x,y,z) 0+#endif+-----------------------------------------------------------------------------+-- |+-- Copyright   :  (C) 2008-2015 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+----------------------------------------------------------------------------+module Data.Bifunctor+  ( -- * Overview+    --+    -- Bifunctors extend the standard 'Functor' to two arguments++    -- * Examples+    -- $examples+    Bifunctor(..)+  ) where++import Control.Applicative+import Data.Functor.Constant++#if MIN_VERSION_semigroups(0,16,2)+import Data.Semigroup+#endif++#ifdef MIN_VERSION_tagged+import Data.Tagged+#endif++#if __GLASGOW_HASKELL__ >= 702+import GHC.Generics (K1(..))+#endif++#if __GLASGOW_HASKELL__ >= 708+import Data.Typeable+#endif++-- | Minimal definition either 'bimap' or 'first' and 'second'++-- | Formally, the class 'Bifunctor' represents a bifunctor+-- from @Hask@ -> @Hask@.+--+-- Intuitively it is a bifunctor where both the first and second arguments are covariant.+--+-- You can define a 'Bifunctor' by either defining 'bimap' or by defining both+-- 'first' and 'second'.+--+-- If you supply 'bimap', you should ensure that:+--+-- @'bimap' 'id' 'id' ≡ 'id'@+--+-- If you supply 'first' and 'second', ensure:+--+-- @+-- 'first' 'id' ≡ 'id'+-- 'second' 'id' ≡ 'id'+-- @+--+-- If you supply both, you should also ensure:+--+-- @'bimap' f g ≡ 'first' f '.' 'second' g@+--+-- These ensure by parametricity:+--+-- @+-- 'bimap'  (f '.' g) (h '.' i) ≡ 'bimap' f h '.' 'bimap' g i+-- 'first'  (f '.' g) ≡ 'first'  f '.' 'first'  g+-- 'second' (f '.' g) ≡ 'second' f '.' 'second' g+-- @+class Bifunctor p where+  -- | Map over both arguments at the same time.+  --+  -- @'bimap' f g ≡ 'first' f '.' 'second' g@+  bimap :: (a -> b) -> (c -> d) -> p a c -> p b d+  bimap f g = first f . second g+  {-# INLINE bimap #-}++  -- | Map covariantly over the first argument.+  --+  -- @'first' f ≡ 'bimap' f 'id'@+  first :: (a -> b) -> p a c -> p b c+  first f = bimap f id+  {-# INLINE first #-}++  -- | Map covariantly over the second argument.+  --+  -- @'second' ≡ 'bimap' 'id'@+  second :: (b -> c) -> p a b -> p a c+  second = bimap id+  {-# INLINE second #-}++#if __GLASGOW_HASKELL__ >= 708+  {-# MINIMAL bimap | first, second #-}+#endif++#if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 710+deriving instance Typeable Bifunctor+#endif++instance Bifunctor (,) where+  bimap f g ~(a, b) = (f a, g b)+  {-# INLINE bimap #-}++#if MIN_VERSION_semigroups(0,16,2)+instance Bifunctor Arg where+  bimap f g (Arg a b) = Arg (f a) (g b)+#endif++instance Bifunctor ((,,) x) where+  bimap f g ~(x, a, b) = (x, f a, g b)+  {-# INLINE bimap #-}++instance Bifunctor ((,,,) x y) where+  bimap f g ~(x, y, a, b) = (x, y, f a, g b)+  {-# INLINE bimap #-}++instance Bifunctor ((,,,,) x y z) where+  bimap f g ~(x, y, z, a, b) = (x, y, z, f a, g b)+  {-# INLINE bimap #-}++instance Bifunctor ((,,,,,) x y z w) where+  bimap f g ~(x, y, z, w, a, b) = (x, y, z, w, f a, g b)+  {-# INLINE bimap #-}++instance Bifunctor ((,,,,,,) x y z w v) where+  bimap f g ~(x, y, z, w, v, a, b) = (x, y, z, w, v, f a, g b)+  {-# INLINE bimap #-}++instance Bifunctor Either where+  bimap f _ (Left a) = Left (f a)+  bimap _ g (Right b) = Right (g b)+  {-# INLINE bimap #-}++instance Bifunctor Const where+  bimap f _ (Const a) = Const (f a)+  {-# INLINE bimap #-}++instance Bifunctor Constant where+  bimap f _ (Constant a) = Constant (f a)+  {-# INLINE bimap #-}++#if __GLASGOW_HASKELL__ >= 702+instance Bifunctor (K1 i) where+  bimap f _ (K1 c) = K1 (f c)+  {-# INLINE bimap #-}+#endif++#ifdef MIN_VERSION_tagged+instance Bifunctor Tagged where+  bimap _ g (Tagged b) = Tagged (g b)+  {-# INLINE bimap #-}+#endif++-- $examples+--+-- ==== __Examples__+--+-- While the standard 'Functor' instance for 'Either' is limited to mapping over 'Right' arguments,+-- the 'Bifunctor' instance allows mapping over the 'Left', 'Right', or both arguments:+--+-- > let x = Left "foo" :: Either String Integer+--+-- In the case of 'first' and 'second', the function may or may not be applied:+--+-- > first (++ "bar") x == Left "foobar"+-- > second (+2) x      == Left "foo"+--+-- In the case of 'bimap', only one of the functions will be applied:+--+-- > bimap (++ "bar") (+2) x == Left "foobar"+--+-- The 'Bifunctor' instance for 2 element tuples allows mapping over one or both of the elements:+--+-- > let x = ("foo",1)+-- >+-- > first  (++ "bar") x      == ("foobar", 1)+-- > second (+2) x            == ("foo", 3)+-- > bimap  (++ "bar") (+2) x == ("foobar", 3)

@@ -0,0 +1,490 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}++#ifndef MIN_VERSION_semigroups+#define MIN_VERSION_semigroups(x,y,z) 0+#endif+-----------------------------------------------------------------------------+-- |+-- Copyright   :  (C) 2011-2015 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+----------------------------------------------------------------------------+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 Control.Monad+import Data.Functor.Constant+import Data.Maybe (fromMaybe)+import Data.Monoid++#if MIN_VERSION_base(4,7,0)+import Data.Coerce+#else+import Unsafe.Coerce+#endif++#if MIN_VERSION_base(4,9,0) || MIN_VERSION_semigroups(0,16,2)+import Data.Semigroup (Arg(..))+#endif++#ifdef MIN_VERSION_tagged+import Data.Tagged+#endif++#if __GLASGOW_HASKELL__ >= 702+import GHC.Generics (K1(..))+#endif++#if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 710+import Data.Typeable+#endif++-- | '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)+class Bifoldable p where+  -- | Combines the elements of a structure using a monoid.+  --+  -- @'bifold' ≡ 'bifoldMap' 'id' 'id'@+  bifold :: Monoid m => p m m -> m+  bifold = bifoldMap id id+  {-# INLINE bifold #-}++  -- | Combines the elements of a structure, given ways of mapping them to a+  -- common monoid.+  --+  -- @'bifoldMap' f g ≡ 'bifoldr' ('mappend' . f) ('mappend' . g) 'mempty'@+  bifoldMap :: Monoid m => (a -> m) -> (b -> m) -> p a b -> m+  bifoldMap f g = bifoldr (mappend . f) (mappend . g) mempty+  {-# INLINE bifoldMap #-}++  -- | 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@+  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+  {-# INLINE bifoldr #-}++  -- | 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.+  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+  {-# INLINE bifoldl #-}++#if __GLASGOW_HASKELL__ >= 708+  {-# MINIMAL bifoldr | bifoldMap #-}+#endif++#if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 710+deriving instance Typeable Bifoldable+#endif++#if MIN_VERSION_base(4,9,0) || MIN_VERSION_semigroups(0,16,2)+instance Bifoldable Arg where+  bifoldMap f g (Arg a b) = f a `mappend` g b+#endif++instance Bifoldable (,) where+  bifoldMap f g ~(a, b) = f a `mappend` g b+  {-# INLINE bifoldMap #-}++instance Bifoldable Const where+  bifoldMap f _ (Const a) = f a+  {-# INLINE bifoldMap #-}++instance Bifoldable Constant where+  bifoldMap f _ (Constant a) = f a+  {-# INLINE bifoldMap #-}++#if __GLASGOW_HASKELL__ >= 702+instance Bifoldable (K1 i) where+  bifoldMap f _ (K1 c) = f c+  {-# INLINE bifoldMap #-}+#endif++instance Bifoldable ((,,) x) where+  bifoldMap f g ~(_,a,b) = f a `mappend` g b+  {-# INLINE bifoldMap #-}++instance Bifoldable ((,,,) x y) where+  bifoldMap f g ~(_,_,a,b) = f a `mappend` g b+  {-# INLINE bifoldMap #-}++instance Bifoldable ((,,,,) x y z) where+  bifoldMap f g ~(_,_,_,a,b) = f a `mappend` g b+  {-# INLINE bifoldMap #-}++instance Bifoldable ((,,,,,) x y z w) where+  bifoldMap f g ~(_,_,_,_,a,b) = f a `mappend` g b+  {-# INLINE bifoldMap #-}++instance Bifoldable ((,,,,,,) x y z w v) where+  bifoldMap f g ~(_,_,_,_,_,a,b) = f a `mappend` g b+  {-# INLINE bifoldMap #-}++#ifdef MIN_VERSION_tagged+instance Bifoldable Tagged where+  bifoldMap _ g (Tagged b) = g b+  {-# INLINE bifoldMap #-}+#endif++instance Bifoldable Either where+  bifoldMap f _ (Left a) = f a+  bifoldMap _ g (Right b) = g b+  {-# INLINE bifoldMap #-}++-- | As 'bifoldr', but strict in the result of the reduction functions at each+-- step.+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+{-# INLINE bifoldr' #-}++-- | A variant of 'bifoldr' that has no base case,+-- and thus may only be applied to non-empty structures.+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)+{-# INLINE bifoldr1 #-}++-- | Right associative monadic bifold over a structure.+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+{-# INLINE bifoldrM #-}++-- | 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').+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+{-# INLINE bifoldl' #-}++-- | A variant of 'bifoldl' that has no base case,+-- and thus may only be applied to non-empty structures.+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)+{-# INLINe bifoldl1 #-}++-- | Left associative monadic bifold over a structure.+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+{-# INLINE bifoldlM #-}++-- | 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'.+bitraverse_ :: (Bifoldable t, Applicative f) => (a -> f c) -> (b -> f d) -> t a b -> f ()+bitraverse_ f g = bifoldr ((*>) . f) ((*>) . g) (pure ())+{-# INLINE bitraverse_ #-}++-- | 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"+bifor_ :: (Bifoldable t, Applicative f) => t a b -> (a -> f c) -> (b -> f d) -> f ()+bifor_ t f g = bitraverse_ f g t+{-# INLINE bifor_ #-}++-- | As 'Data.Bitraversable.bimapM', but ignores the results of the functions,+-- merely performing the "actions".+bimapM_:: (Bifoldable t, Monad m) => (a -> m c) -> (b -> m d) -> t a b -> m ()+bimapM_ f g = bifoldr ((>>) . f) ((>>) . g) (return ())+{-# INLINE bimapM_ #-}++-- | As 'bimapM_', but with the structure as the primary argument.+biforM_ :: (Bifoldable t, Monad m) => t a b ->  (a -> m c) -> (b -> m d) -> m ()+biforM_ t f g = bimapM_ f g t+{-# INLINE biforM_ #-}++-- | As 'Data.Bitraversable.bisequenceA', but ignores the results of the actions.+bisequenceA_ :: (Bifoldable t, Applicative f) => t (f a) (f b) -> f ()+bisequenceA_ = bifoldr (*>) (*>) (pure ())+{-# INLINE bisequenceA_ #-}++-- | 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'.+bisequence_ :: (Bifoldable t, Monad m) => t (m a) (m b) -> m ()+bisequence_ = bifoldr (>>) (>>) (return ())+{-# INLINE bisequence_ #-}++-- | The sum of a collection of actions, generalizing 'biconcat'.+biasum :: (Bifoldable t, Alternative f) => t (f a) (f a) -> f a+biasum = bifoldr (<|>) (<|>) empty+{-# INLINE biasum #-}++-- | The sum of a collection of actions, generalizing 'biconcat'.+bimsum :: (Bifoldable t, MonadPlus m) => t (m a) (m a) -> m a+bimsum = bifoldr mplus mplus mzero+{-# INLINE bimsum #-}++-- | Collects the list of elements of a structure, from left to right.+biList :: Bifoldable t => t a a -> [a]+biList = bifoldr (:) (:) []+{-# INLINE biList #-}++-- | Test whether the structure is empty.+binull :: Bifoldable t => t a b -> Bool+binull = bifoldr (\_ _ -> False) (\_ _ -> False) True+{-# INLINE binull #-}++-- | Returns the size/length of a finite structure as an 'Int'.+bilength :: Bifoldable t => t a b -> Int+bilength = bifoldl' (\c _ -> c+1) (\c _ -> c+1) 0+{-# INLINE bilength #-}++-- | Does the element occur in the structure?+bielem :: (Bifoldable t, Eq a) => a -> t a a -> Bool+bielem x = biany (== x) (== x)+{-# INLINE bielem #-}++-- | Reduces a structure of lists to the concatenation of those lists.+biconcat :: Bifoldable t => t [a] [a] -> [a]+biconcat = bifold+{-# INLINE biconcat #-}++newtype Max a = Max {getMax :: Maybe a}+newtype Min a = Min {getMin :: Maybe a}++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++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++-- | The largest element of a non-empty structure.+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)+{-# INLINE bimaximum #-}++-- | The least element of a non-empty structure.+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)+{-# INLINE biminimum #-}++-- | The 'bisum' function computes the sum of the numbers of a structure.+bisum :: (Bifoldable t, Num a) => t a a -> a+bisum = getSum #. bifoldMap Sum Sum+{-# INLINE bisum #-}++-- | The 'biproduct' function computes the product of the numbers of a+-- structure.+biproduct :: (Bifoldable t, Num a) => t a a -> a+biproduct = getProduct #. bifoldMap Product Product+{-# INLINE biproduct #-}++-- | Given a means of mapping the elements of a structure to lists, computes the+-- concatenation of all such lists in order.+biconcatMap :: Bifoldable t => (a -> [c]) -> (b -> [c]) -> t a b -> [c]+biconcatMap = bifoldMap+{-# INLINE biconcatMap #-}++-- | '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.+biand :: Bifoldable t => t Bool Bool -> Bool+biand = getAll #. bifoldMap All All+{-# INLINE biand #-}++-- | '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.+bior :: Bifoldable t => t Bool Bool -> Bool+bior = getAny #. bifoldMap Any Any+{-# INLINE bior #-}++-- | Determines whether any element of the structure satisfies the appropriate+-- predicate.+biany :: Bifoldable t => (a -> Bool) -> (b -> Bool) -> t a b -> Bool+biany p q = getAny #. bifoldMap (Any . p) (Any . q)+{-# INLINE biany #-}++-- | Determines whether all elements of the structure satisfy the appropriate+-- predicate.+biall :: Bifoldable t => (a -> Bool) -> (b -> Bool) -> t a b -> Bool+biall p q = getAll #. bifoldMap (All . p) (All . q)+{-# INLINE biall #-}++-- | The largest element of a non-empty structure with respect to the+-- given comparison function.+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+{-# INLINE bimaximumBy #-}++-- | The least element of a non-empty structure with respect to the+-- given comparison function.+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+{-# INLINE biminimumBy #-}++-- | 'binotElem' is the negation of 'bielem'.+binotElem :: (Bifoldable t, Eq a) => a -> t a a-> Bool+binotElem x =  not . bielem x+{-# INLINE binotElem #-}++-- | 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.+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)+{-# INLINE bifind #-}++-- See Note [Function coercion]+#if MIN_VERSION_base(4,7,0)+(#.) :: Coercible b c => (b -> c) -> (a -> b) -> (a -> c)+(#.) _f = coerce+#else+(#.) :: (b -> c) -> (a -> b) -> (a -> c)+(#.) _f = unsafeCoerce+#endif+{-# 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.+-}

@@ -0,0 +1,312 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE StandaloneDeriving #-}++#ifndef MIN_VERSION_semigroups+#define MIN_VERSION_semigroups(x,y,z) 0+#endif+-----------------------------------------------------------------------------+-- |+-- Copyright   :  (C) 2011-2015 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+----------------------------------------------------------------------------+module Data.Bitraversable+  ( Bitraversable(..)+  , bisequenceA+  , bisequence+  , bimapM+  , bifor+  , biforM+  , bimapAccumL+  , bimapAccumR+  , bimapDefault+  , bifoldMapDefault+  ) where++import Control.Applicative+import Control.Monad.Trans.Instances ()+import Data.Bifunctor+import Data.Bifoldable+import Data.Functor.Constant+import Data.Orphans ()++#if !(MIN_VERSION_base(4,8,0))+import Data.Monoid+#endif++#if MIN_VERSION_base(4,9,0) || MIN_VERSION_semigroups(0,16,2)+import Data.Semigroup (Arg(..))+#endif++#ifdef MIN_VERSION_tagged+import Data.Tagged+#endif++#if __GLASGOW_HASKELL__ >= 702+import GHC.Generics (K1(..))+#endif++#if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 710+import Data.Typeable+#endif++-- | '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.+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+  -- elements produced from sequencing the actions.+  --+  -- @'bitraverse' f g ≡ 'bisequenceA' . 'bimap' f g@+  --+  -- For a version that ignores the results, see 'bitraverse_'.+  bitraverse :: Applicative f => (a -> f c) -> (b -> f d) -> t a b -> f (t c d)+  bitraverse f g = bisequenceA . bimap f g+  {-# INLINE 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 'bisequenceA_'.+--+-- @'bisequenceA' ≡ 'bitraverse' 'id' 'id'@+bisequenceA :: (Bitraversable t, Applicative f) => t (f a) (f b) -> f (t a b)+bisequenceA = bitraverse id id+{-# INLINE bisequenceA #-}++-- | As 'bitraverse', but uses evidence that @m@ is a 'Monad' rather than an+-- 'Applicative'. For a version that ignores the results, see 'bimapM_'.+--+-- @+-- 'bimapM' f g ≡ 'bisequence' . 'bimap' f g+-- 'bimapM' f g ≡ 'unwrapMonad' . 'bitraverse' ('WrapMonad' . f) ('WrapMonad' . g)+-- @+bimapM :: (Bitraversable t, Monad m) => (a -> m c) -> (b -> m d) -> t a b -> m (t c d)+bimapM f g = unwrapMonad . bitraverse (WrapMonad . f) (WrapMonad . g)+{-# INLINE bimapM #-}++-- | As 'bisequenceA', but uses evidence that @m@ is a 'Monad' rather than an+-- 'Applicative'. For a version that ignores the results, see 'bisequence_'.+--+-- @+-- 'bisequence' ≡ 'bimapM' 'id' 'id'+-- 'bisequence' ≡ 'unwrapMonad' . 'bisequenceA' . 'bimap' 'WrapMonad' 'WrapMonad'+-- @+bisequence :: (Bitraversable t, Monad m) => t (m a) (m b) -> m (t a b)+bisequence = bimapM id id+{-# INLINE bisequence #-}++#if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 710+deriving instance Typeable Bitraversable+#endif++#if MIN_VERSION_base(4,9,0) || MIN_VERSION_semigroups(0,16,2)+instance Bitraversable Arg where+  bitraverse f g (Arg a b) = Arg <$> f a <*> g b+#endif++instance Bitraversable (,) where+  bitraverse f g ~(a, b) = (,) <$> f a <*> g b+  {-# INLINE bitraverse #-}++instance Bitraversable ((,,) x) where+  bitraverse f g ~(x, a, b) = (,,) x <$> f a <*> g b+  {-# INLINE bitraverse #-}++instance Bitraversable ((,,,) x y) where+  bitraverse f g ~(x, y, a, b) = (,,,) x y <$> f a <*> g b+  {-# INLINE bitraverse #-}++instance Bitraversable ((,,,,) x y z) where+  bitraverse f g ~(x, y, z, a, b) = (,,,,) x y z <$> f a <*> g b+  {-# INLINE bitraverse #-}++instance Bitraversable ((,,,,,) x y z w) where+  bitraverse f g ~(x, y, z, w, a, b) = (,,,,,) x y z w <$> f a <*> g b+  {-# INLINE bitraverse #-}++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+  {-# INLINE bitraverse #-}++instance Bitraversable Either where+  bitraverse f _ (Left a) = Left <$> f a+  bitraverse _ g (Right b) = Right <$> g b+  {-# INLINE bitraverse #-}++instance Bitraversable Const where+  bitraverse f _ (Const a) = Const <$> f a+  {-# INLINE bitraverse #-}++instance Bitraversable Constant where+  bitraverse f _ (Constant a) = Constant <$> f a+  {-# INLINE bitraverse #-}++#if __GLASGOW_HASKELL__ >= 702+instance Bitraversable (K1 i) where+  bitraverse f _ (K1 c) = K1 <$> f c+  {-# INLINE bitraverse #-}+#endif++#ifdef MIN_VERSION_tagged+instance Bitraversable Tagged where+  bitraverse _ g (Tagged b) = Tagged <$> g b+  {-# INLINE bitraverse #-}+#endif++-- | 'bifor' is 'bitraverse' with the structure as the first argument. For a+-- version that ignores the results, see 'bifor_'.+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+{-# INLINE bifor #-}++-- | 'biforM' is 'bimapM' with the structure as the first argument. For a+-- version that ignores the results, see 'biforM_'.+biforM :: (Bitraversable t, Monad m) =>  t a b -> (a -> m c) -> (b -> m d) -> m (t c d)+biforM t f g = bimapM f g t+{-# INLINE biforM #-}++-- | left-to-right state transformer+newtype StateL s a = StateL { runStateL :: s -> (s, a) }++instance Functor (StateL s) where+  fmap f (StateL k) = StateL $ \ s ->+    let (s', v) = k s in (s', f v)+  {-# INLINE fmap #-}++instance Applicative (StateL s) where+  pure x = StateL (\ s -> (s, x))+  {-# INLINE pure #-}+  StateL kf <*> StateL kv = StateL $ \ s ->+    let (s', f) = kf s+        (s'', v) = kv s'+    in (s'', f v)+  {-# INLINE (<*>) #-}++-- | 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.+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+{-# INLINE bimapAccumL #-}++-- | right-to-left state transformer+newtype StateR s a = StateR { runStateR :: s -> (s, a) }++instance Functor (StateR s) where+  fmap f (StateR k) = StateR $ \ s ->+    let (s', v) = k s in (s', f v)+  {-# INLINE fmap #-}++instance Applicative (StateR s) where+  pure x = StateR (\ s -> (s, x))+  {-# INLINE pure #-}+  StateR kf <*> StateR kv = StateR $ \ s ->+    let (s', v) = kv s+        (s'', f) = kf s'+    in (s'', f v)+  {-# INLINE (<*>) #-}++-- | 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.+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+{-# INLINE bimapAccumR #-}++newtype Id a = Id { getId :: a }++instance Functor Id where+  fmap f (Id x) = Id (f x)+  {-# INLINE fmap #-}++instance Applicative Id where+  pure = Id+  {-# INLINE pure #-}+  Id f <*> Id x = Id (f x)+  {-# INLINE (<*>) #-}++-- | A default definition of 'bimap' in terms of the 'Bitraversable' operations.+bimapDefault :: Bitraversable t => (a -> b) -> (c -> d) -> t a c -> t b d+bimapDefault f g = getId . bitraverse (Id . f) (Id . g)+{-# INLINE bimapDefault #-}++-- | A default definition of 'bifoldMap' in terms of the 'Bitraversable' operations.+bifoldMapDefault :: (Bitraversable t, Monoid m) => (a -> m) -> (b -> m) -> t a b -> m+bifoldMapDefault f g = getConst . bitraverse (Const . f) (Const . g)+{-# INLINE bifoldMapDefault #-}

@@ -1,422 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE StandaloneDeriving #-}--#ifndef MIN_VERSION_semigroups-#define MIN_VERSION_semigroups(x,y,z) 0-#endif--------------------------------------------------------------------------------- |--- Copyright   :  (C) 2011-2015 Edward Kmett--- License     :  BSD-style (see the file LICENSE)------ Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  provisional--- Portability :  portable---------------------------------------------------------------------------------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 Control.Monad-import Data.Functor.Constant-import Data.Maybe (fromMaybe)-import Data.Monoid--#if MIN_VERSION_base(4,9,0) || MIN_VERSION_semigroups(0,16,2)-import Data.Semigroup (Arg(..))-#endif--#ifdef MIN_VERSION_tagged-import Data.Tagged-#endif--#if __GLASGOW_HASKELL__ >= 702-import GHC.Generics (K1(..))-#endif--#if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 710-import Data.Typeable-#endif---- | Minimal definition either 'bifoldr' or 'bifoldMap'---- | 'Bifoldable' identifies foldable structures with two different varieties of--- elements. 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)------ When defining more than the minimal set of definitions, 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--- @-class Bifoldable p where-  -- | Combines the elements of a structure using a monoid.-  ---  -- @'bifold' ≡ 'bifoldMap' 'id' 'id'@-  bifold :: Monoid m => p m m -> m-  bifold = bifoldMap id id-  {-# INLINE bifold #-}--  -- | Combines the elements of a structure, given ways of mapping them to a-  -- common monoid.-  ---  -- @'bifoldMap' f g ≡ 'bifoldr' ('mappend' . f) ('mappend' . g) 'mempty'@-  bifoldMap :: Monoid m => (a -> m) -> (b -> m) -> p a b -> m-  bifoldMap f g = bifoldr (mappend . f) (mappend . g) mempty-  {-# INLINE bifoldMap #-}--  -- | 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@-  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-  {-# INLINE bifoldr #-}--  -- | 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@-  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-  {-# INLINE bifoldl #-}--#if __GLASGOW_HASKELL__ >= 708-  {-# MINIMAL bifoldr | bifoldMap #-}-#endif--#if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 710-deriving instance Typeable Bifoldable-#endif--#if MIN_VERSION_base(4,9,0) || MIN_VERSION_semigroups(0,16,2)-instance Bifoldable Arg where-  bifoldMap f g (Arg a b) = f a `mappend` g b-#endif--instance Bifoldable (,) where-  bifoldMap f g ~(a, b) = f a `mappend` g b-  {-# INLINE bifoldMap #-}--instance Bifoldable Const where-  bifoldMap f _ (Const a) = f a-  {-# INLINE bifoldMap #-}--instance Bifoldable Constant where-  bifoldMap f _ (Constant a) = f a-  {-# INLINE bifoldMap #-}--#if __GLASGOW_HASKELL__ >= 702-instance Bifoldable (K1 i) where-  bifoldMap f _ (K1 c) = f c-  {-# INLINE bifoldMap #-}-#endif--instance Bifoldable ((,,) x) where-  bifoldMap f g ~(_,a,b) = f a `mappend` g b-  {-# INLINE bifoldMap #-}--instance Bifoldable ((,,,) x y) where-  bifoldMap f g ~(_,_,a,b) = f a `mappend` g b-  {-# INLINE bifoldMap #-}--instance Bifoldable ((,,,,) x y z) where-  bifoldMap f g ~(_,_,_,a,b) = f a `mappend` g b-  {-# INLINE bifoldMap #-}--instance Bifoldable ((,,,,,) x y z w) where-  bifoldMap f g ~(_,_,_,_,a,b) = f a `mappend` g b-  {-# INLINE bifoldMap #-}--instance Bifoldable ((,,,,,,) x y z w v) where-  bifoldMap f g ~(_,_,_,_,_,a,b) = f a `mappend` g b-  {-# INLINE bifoldMap #-}--#ifdef MIN_VERSION_tagged-instance Bifoldable Tagged where-  bifoldMap _ g (Tagged b) = g b-  {-# INLINE bifoldMap #-}-#endif--instance Bifoldable Either where-  bifoldMap f _ (Left a) = f a-  bifoldMap _ g (Right b) = g b-  {-# INLINE bifoldMap #-}---- | As 'bifoldr', but strict in the result of the reduction functions at each--- step.-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-{-# INLINE bifoldr' #-}---- | A variant of 'bifoldr' that has no base case,--- and thus may only be applied to non-empty structures.-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)-{-# INLINE bifoldr1 #-}---- | Right associative monadic bifold over a structure.-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-{-# INLINE bifoldrM #-}---- | As 'bifoldl', but strict in the result of the reductionf unctions at each--- step.-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-{-# INLINE bifoldl' #-}---- | A variant of 'bifoldl' that has no base case,--- and thus may only be applied to non-empty structures.-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)-{-# INLINe bifoldl1 #-}---- | Left associative monadic bifold over a structure.-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-{-# INLINE bifoldlM #-}---- | As 'Data.Bitraversable.bitraverse', but ignores the results of the--- functions, merely performing the "actions".-bitraverse_ :: (Bifoldable t, Applicative f) => (a -> f c) -> (b -> f d) -> t a b -> f ()-bitraverse_ f g = bifoldr ((*>) . f) ((*>) . g) (pure ())-{-# INLINE bitraverse_ #-}---- | As 'bitraverse_', but with the structure as the primary argument.-bifor_ :: (Bifoldable t, Applicative f) => t a b -> (a -> f c) -> (b -> f d) -> f ()-bifor_ t f g = bitraverse_ f g t-{-# INLINE bifor_ #-}---- | As 'Data.Bitraversable.bimapM', but ignores the results of the functions,--- merely performing--- the "actions".-bimapM_:: (Bifoldable t, Monad m) => (a -> m c) -> (b -> m d) -> t a b -> m ()-bimapM_ f g = bifoldr ((>>) . f) ((>>) . g) (return ())-{-# INLINE bimapM_ #-}---- | As 'bimapM_', but with the structure as the primary argument.-biforM_ :: (Bifoldable t, Monad m) => t a b ->  (a -> m c) -> (b -> m d) -> m ()-biforM_ t f g = bimapM_ f g t-{-# INLINE biforM_ #-}---- | As 'Data.Bitraversable.bisequenceA', but ignores the results of the actions.-bisequenceA_ :: (Bifoldable t, Applicative f) => t (f a) (f b) -> f ()-bisequenceA_ = bifoldr (*>) (*>) (pure ())-{-# INLINE bisequenceA_ #-}---- | As 'Data.Bitraversable.bisequence', but ignores the results of the actions.-bisequence_ :: (Bifoldable t, Monad m) => t (m a) (m b) -> m ()-bisequence_ = bifoldr (>>) (>>) (return ())-{-# INLINE bisequence_ #-}---- | The sum of a collection of actions, generalizing 'biconcat'.-biasum :: (Bifoldable t, Alternative f) => t (f a) (f a) -> f a-biasum = bifoldr (<|>) (<|>) empty-{-# INLINE biasum #-}---- | The sum of a collection of actions, generalizing 'biconcat'.-bimsum :: (Bifoldable t, MonadPlus m) => t (m a) (m a) -> m a-bimsum = bifoldr mplus mplus mzero-{-# INLINE bimsum #-}---- | Collects the list of elements of a structure in order.-biList :: Bifoldable t => t a a -> [a]-biList = bifoldr (:) (:) []-{-# INLINE biList #-}---- | Test whether the structure is empty.-binull :: Bifoldable t => t a b -> Bool-binull = bifoldr (\_ _ -> False) (\_ _ -> False) True-{-# INLINE binull #-}---- | Returns the size/length of a finite structure as an 'Int'.-bilength :: Bifoldable t => t a b -> Int-bilength = bifoldl' (\c _ -> c+1) (\c _ -> c+1) 0-{-# INLINE bilength #-}---- | Does the element occur in the structure?-bielem :: (Bifoldable t, Eq a) => a -> t a a -> Bool-bielem x = biany (== x) (== x)-{-# INLINE bielem #-}---- | Reduces a structure of lists to the concatenation of those lists.-biconcat :: Bifoldable t => t [a] [a] -> [a]-biconcat = bifold-{-# INLINE biconcat #-}--newtype Max a = Max {getMax :: Maybe a}-newtype Min a = Min {getMin :: Maybe a}--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--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---- | The largest element of a non-empty structure.-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)-{-# INLINE bimaximum #-}---- | The least element of a non-empty structure.-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)-{-# INLINE biminimum #-}---- | The 'bisum' function computes the sum of the numbers of a structure.-bisum :: (Bifoldable t, Num a) => t a a -> a-bisum = getSum . bifoldMap Sum Sum-{-# INLINE bisum #-}---- | The 'biproduct' function computes the product of the numbers of a--- structure.-biproduct :: (Bifoldable t, Num a) => t a a -> a-biproduct = getProduct . bifoldMap Product Product-{-# INLINE biproduct #-}---- | Given a means of mapping the elements of a structure to lists, computes the--- concatenation of all such lists in order.-biconcatMap :: Bifoldable t => (a -> [c]) -> (b -> [c]) -> t a b -> [c]-biconcatMap = bifoldMap-{-# INLINE biconcatMap #-}---- | '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.-biand :: Bifoldable t => t Bool Bool -> Bool-biand = getAll . bifoldMap All All-{-# INLINE biand #-}---- | '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.-bior :: Bifoldable t => t Bool Bool -> Bool-bior = getAny . bifoldMap Any Any-{-# INLINE bior #-}---- | Determines whether any element of the structure satisfies the appropriate--- predicate.-biany :: Bifoldable t => (a -> Bool) -> (b -> Bool) -> t a b -> Bool-biany p q = getAny . bifoldMap (Any . p) (Any . q)-{-# INLINE biany #-}---- | Determines whether all elements of the structure satisfy the appropriate--- predicate.-biall :: Bifoldable t => (a -> Bool) -> (b -> Bool) -> t a b -> Bool-biall p q = getAll . bifoldMap (All . p) (All . q)-{-# INLINE biall #-}---- | The largest element of a non-empty structure with respect to the--- given comparison function.-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-{-# INLINE bimaximumBy #-}---- | The least element of a non-empty structure with respect to the--- given comparison function.-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-{-# INLINE biminimumBy #-}---- | 'binotElem' is the negation of 'bielem'.-binotElem :: (Bifoldable t, Eq a) => a -> t a a-> Bool-binotElem x =  not . bielem x-{-# INLINE binotElem #-}---- | 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.-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)-{-# INLINE bifind #-}

@@ -391,8 +391,29 @@       mentionsTyArgs :: Bool       mentionsTyArgs = any (`mentionsName` tyVarNames) tyArgs -      makeBiFunTuple :: Type -> Name -> Q (Either Exp Exp)-      makeBiFunTuple fieldTy fieldName =+      makeBiFunTuple :: ([Q Pat] -> Q Pat) -> (Int -> Name) -> Int+                     -> Q (Either Exp Exp)+      makeBiFunTuple mkTupP mkTupleDataName n = do+        args <- mapM newName $ catMaybes [ Just "x"+                                         , guard (biFun == Bifoldr) >> Just "z"+                                         ]+        xs <- newNameList "_tup" n++        let x = head args+            z = last args+        fmap Right $ lamE (map varP args) $ caseE (varE x)+             [ match (mkTupP $ map varP xs)+                     (normalB $ biFunCombine biFun+                                             (mkTupleDataName n)+                                             z+                                             xs+                                             (zipWithM makeBiFunTupleField tyArgs xs)+                     )+                     []+             ]++      makeBiFunTupleField :: Type -> Name -> Q (Either Exp Exp)+      makeBiFunTupleField fieldTy fieldName =         makeBiFunForType biFun tvMap conName covariant fieldTy           `appEitherE` varE fieldName @@ -408,25 +429,12 @@          where            covBiFun :: Bool -> Type -> Q Exp            covBiFun cov = fmap fromEither . makeBiFunForType biFun tvMap conName cov+#if MIN_VERSION_template_haskell(2,6,0)+     UnboxedTupleT n+       | n > 0 && mentionsTyArgs -> makeBiFunTuple unboxedTupP unboxedTupleDataName n+#endif      TupleT n-       | n > 0 && mentionsTyArgs -> do-         args <- mapM newName $ catMaybes [ Just "x"-                                          , guard (biFun == Bifoldr) >> Just "z"-                                          ]-         xs <- newNameList "_tup" n--         let x = head args-             z = last args-         fmap Right $ lamE (map varP args) $ caseE (varE x)-              [ match (tupP $ map varP xs)-                      (normalB $ biFunCombine biFun-                                              (tupleDataName n)-                                              z-                                              xs-                                              (zipWithM makeBiFunTuple tyArgs xs)-                      )-                      []-              ]+       | n > 0 && mentionsTyArgs -> makeBiFunTuple tupP tupleDataName n      _ -> do          itf <- isTyFamily tyCon          if any (`mentionsName` tyVarNames) lhsArgs || (itf && mentionsTyArgs)@@ -601,11 +609,11 @@         -- types without kind annotations.         instTys :: [Type]         instTys = map (substNamesWithKinds (zip kindVarNames givenKinds'))-                  -- ^ Note that due to a GHC 7.8-specific bug-                  --   (see Note [Polykinded data families in Template Haskell]),-                  --   there may be more kind variable names than there are kinds-                  --   to substitute. But this is OK! If a kind is eta-reduced, it-                  --   means that is was not instantiated to something more specific,+                  -- Note that due to a GHC 7.8-specific bug+                  -- (see Note [Polykinded data families in Template Haskell]),+                  -- there may be more kind variable names than there are kinds+                  -- to substitute. But this is OK! If a kind is eta-reduced, it+                  -- means that is was not instantiated to something more specific,                   --   so we need not substitute it. Using stealKindForType will                   --   grab the correct kind.                 $ zipWith stealKindForType tvbs (givenTys ++ xTys)

@@ -25,6 +25,11 @@ import           Language.Haskell.TH.Lib import           Language.Haskell.TH.Syntax +-- Ensure, beyond a shadow of a doubt, that the instances are in-scope+import           Data.Bifunctor ()+import           Data.Bifoldable ()+import           Data.Bitraversable ()+ #ifndef CURRENT_PACKAGE_KEY import           Data.Version (showVersion) import           Paths_bifunctors (version)@@ -502,21 +507,6 @@ mkBifunctorsName_v :: String -> String -> Name mkBifunctorsName_v = mkNameG_v bifunctorsPackageKey -bifoldableTypeName :: Name-bifoldableTypeName = mkBifunctorsName_tc "Data.Bifoldable" "Bifoldable"--bitraversableTypeName :: Name-bitraversableTypeName = mkBifunctorsName_tc "Data.Bitraversable" "Bitraversable"--bifoldrValName :: Name-bifoldrValName = mkBifunctorsName_v "Data.Bifoldable" "bifoldr"--bifoldMapValName :: Name-bifoldMapValName = mkBifunctorsName_v "Data.Bifoldable" "bifoldMap"--bitraverseValName :: Name-bitraverseValName = mkBifunctorsName_v "Data.Bitraversable" "bitraverse"- bimapConstValName :: Name bimapConstValName = mkBifunctorsName_v "Data.Bifunctor.TH.Internal" "bimapConst" @@ -621,4 +611,36 @@  memptyValName :: Name memptyValName = mkNameG_v "base" "Data.Monoid" "mempty"+#endif++#if __GLASGOW_HASKELL__ >= 801+bifoldableTypeName :: Name+bifoldableTypeName = mkNameG_tc "base" "Data.Bifoldable" "Bifoldable"++bitraversableTypeName :: Name+bitraversableTypeName = mkNameG_tc "base" "Data.Bitraversable" "Bitraversable"++bifoldrValName :: Name+bifoldrValName = mkNameG_v "base" "Data.Bifoldable" "bifoldr"++bifoldMapValName :: Name+bifoldMapValName = mkNameG_v "base" "Data.Bifoldable" "bifoldMap"++bitraverseValName :: Name+bitraverseValName = mkNameG_v "base" "Data.Bitraversable" "bitraverse"+#else+bifoldableTypeName :: Name+bifoldableTypeName = mkBifunctorsName_tc "Data.Bifoldable" "Bifoldable"++bitraversableTypeName :: Name+bitraversableTypeName = mkBifunctorsName_tc "Data.Bitraversable" "Bitraversable"++bifoldrValName :: Name+bifoldrValName = mkBifunctorsName_v "Data.Bifoldable" "bifoldr"++bifoldMapValName :: Name+bifoldMapValName = mkBifunctorsName_v "Data.Bifoldable" "bifoldMap"++bitraverseValName :: Name+bitraverseValName = mkBifunctorsName_v "Data.Bitraversable" "bitraverse" #endif

@@ -1,299 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE StandaloneDeriving #-}--#ifndef MIN_VERSION_semigroups-#define MIN_VERSION_semigroups(x,y,z) 0-#endif--------------------------------------------------------------------------------- |--- Copyright   :  (C) 2011-2015 Edward Kmett--- License     :  BSD-style (see the file LICENSE)------ Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  provisional--- Portability :  portable---------------------------------------------------------------------------------module Data.Bitraversable-  ( Bitraversable(..)-  , bisequenceA-  , bisequence-  , bimapM-  , bifor-  , biforM-  , bimapAccumL-  , bimapAccumR-  , bimapDefault-  , bifoldMapDefault-  ) where--import Control.Applicative-import Control.Monad.Trans.Instances ()-import Data.Bifunctor-import Data.Bifoldable-import Data.Functor.Constant-import Data.Orphans ()--#if !(MIN_VERSION_base(4,8,0))-import Data.Monoid-#endif--#if MIN_VERSION_base(4,9,0) || MIN_VERSION_semigroups(0,16,2)-import Data.Semigroup (Arg(..))-#endif--#ifdef MIN_VERSION_tagged-import Data.Tagged-#endif--#if __GLASGOW_HASKELL__ >= 702-import GHC.Generics (K1(..))-#endif--#if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 710-import Data.Typeable-#endif---- | '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.------ 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.-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-  -- elements produced from sequencing the actions.-  ---  -- @'bitraverse' f g ≡ 'bisequenceA' . 'bimap' f g@-  bitraverse :: Applicative f => (a -> f c) -> (b -> f d) -> t a b -> f (t c d)-  bitraverse f g = bisequenceA . bimap f g-  {-# INLINE bitraverse #-}----- | Sequences all the actions in a structure, building a new structure with the--- same shape using the results of the actions.------ @'bisequenceA' ≡ 'bitraverse' 'id' 'id'@-bisequenceA :: (Bitraversable t, Applicative f) => t (f a) (f b) -> f (t a b)-bisequenceA = bitraverse id id-{-# INLINE bisequenceA #-}---- | As 'bitraverse', but uses evidence that @m@ is a 'Monad' rather than an--- 'Applicative'.------ @--- 'bimapM' f g ≡ 'bisequence' . 'bimap' f g--- 'bimapM' f g ≡ 'unwrapMonad' . 'bitraverse' ('WrapMonad' . f) ('WrapMonad' . g)--- @-bimapM :: (Bitraversable t, Monad m) => (a -> m c) -> (b -> m d) -> t a b -> m (t c d)-bimapM f g = unwrapMonad . bitraverse (WrapMonad . f) (WrapMonad . g)-{-# INLINE bimapM #-}---- | As 'bisequenceA', but uses evidence that @m@ is a 'Monad' rather than an--- 'Applicative'.------ @--- 'bisequence' ≡ 'bimapM' 'id' 'id'--- 'bisequence' ≡ 'unwrapMonad' . 'bisequenceA' . 'bimap' 'WrapMonad' 'WrapMonad'--- @-bisequence :: (Bitraversable t, Monad m) => t (m a) (m b) -> m (t a b)-bisequence = bimapM id id-{-# INLINE bisequence #-}--#if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 710-deriving instance Typeable Bitraversable-#endif--#if MIN_VERSION_base(4,9,0) || MIN_VERSION_semigroups(0,16,2)-instance Bitraversable Arg where-  bitraverse f g (Arg a b) = Arg <$> f a <*> g b-#endif--instance Bitraversable (,) where-  bitraverse f g ~(a, b) = (,) <$> f a <*> g b-  {-# INLINE bitraverse #-}--instance Bitraversable ((,,) x) where-  bitraverse f g ~(x, a, b) = (,,) x <$> f a <*> g b-  {-# INLINE bitraverse #-}--instance Bitraversable ((,,,) x y) where-  bitraverse f g ~(x, y, a, b) = (,,,) x y <$> f a <*> g b-  {-# INLINE bitraverse #-}--instance Bitraversable ((,,,,) x y z) where-  bitraverse f g ~(x, y, z, a, b) = (,,,,) x y z <$> f a <*> g b-  {-# INLINE bitraverse #-}--instance Bitraversable ((,,,,,) x y z w) where-  bitraverse f g ~(x, y, z, w, a, b) = (,,,,,) x y z w <$> f a <*> g b-  {-# INLINE bitraverse #-}--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-  {-# INLINE bitraverse #-}--instance Bitraversable Either where-  bitraverse f _ (Left a) = Left <$> f a-  bitraverse _ g (Right b) = Right <$> g b-  {-# INLINE bitraverse #-}--instance Bitraversable Const where-  bitraverse f _ (Const a) = Const <$> f a-  {-# INLINE bitraverse #-}--instance Bitraversable Constant where-  bitraverse f _ (Constant a) = Constant <$> f a-  {-# INLINE bitraverse #-}--#if __GLASGOW_HASKELL__ >= 702-instance Bitraversable (K1 i) where-  bitraverse f _ (K1 c) = K1 <$> f c-  {-# INLINE bitraverse #-}-#endif--#ifdef MIN_VERSION_tagged-instance Bitraversable Tagged where-  bitraverse _ g (Tagged b) = Tagged <$> g b-  {-# INLINE bitraverse #-}-#endif---- | 'bifor' is 'bitraverse' with the structure as the first argument.-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-{-# INLINE bifor #-}---- | 'biforM' is 'bimapM' with the structure as the first argument.-biforM :: (Bitraversable t, Monad m) =>  t a b -> (a -> m c) -> (b -> m d) -> m (t c d)-biforM t f g = bimapM f g t-{-# INLINE biforM #-}---- | left-to-right state transformer-newtype StateL s a = StateL { runStateL :: s -> (s, a) }--instance Functor (StateL s) where-  fmap f (StateL k) = StateL $ \ s ->-    let (s', v) = k s in (s', f v)-  {-# INLINE fmap #-}--instance Applicative (StateL s) where-  pure x = StateL (\ s -> (s, x))-  {-# INLINE pure #-}-  StateL kf <*> StateL kv = StateL $ \ s ->-    let (s', f) = kf s-        (s'', v) = kv s'-    in (s'', f v)-  {-# INLINE (<*>) #-}---- | 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.-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-{-# INLINE bimapAccumL #-}---- | right-to-left state transformer-newtype StateR s a = StateR { runStateR :: s -> (s, a) }--instance Functor (StateR s) where-  fmap f (StateR k) = StateR $ \ s ->-    let (s', v) = k s in (s', f v)-  {-# INLINE fmap #-}--instance Applicative (StateR s) where-  pure x = StateR (\ s -> (s, x))-  {-# INLINE pure #-}-  StateR kf <*> StateR kv = StateR $ \ s ->-    let (s', v) = kv s-        (s'', f) = kf s'-    in (s'', f v)-  {-# INLINE (<*>) #-}---- | 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.-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-{-# INLINE bimapAccumR #-}--newtype Id a = Id { getId :: a }--instance Functor Id where-  fmap f (Id x) = Id (f x)-  {-# INLINE fmap #-}--instance Applicative Id where-  pure = Id-  {-# INLINE pure #-}-  Id f <*> Id x = Id (f x)-  {-# INLINE (<*>) #-}---- | A default definition of 'bimap' in terms of the 'Bitraversable' operations.-bimapDefault :: Bitraversable t => (a -> b) -> (c -> d) -> t a c -> t b d-bimapDefault f g = getId . bitraverse (Id . f) (Id . g)-{-# INLINE bimapDefault #-}---- | A default definition of 'bifoldMap' in terms of the 'Bitraversable' operations.-bifoldMapDefault :: (Bitraversable t, Monoid m) => (a -> m) -> (b -> m) -> t a b -> m-bifoldMapDefault f g = getConst . bitraverse (Const . f) (Const . g)-{-# INLINE bifoldMapDefault #-}

@@ -275,9 +275,8 @@ prop_BifoldableEx :: Bifoldable p => p [Int] [Int] -> Bool prop_BifoldableEx = prop_BifoldableLaws reverse (++ [42]) ((+) . length) ((*) . length) 0 -prop_BitraversableLaws :: (Applicative f, Applicative g,-                           Bitraversable p, Eq (f (p c c)), Eq (g (p c c)),-                           Eq (p a b), Eq (p d e), Eq1 f)+prop_BitraversableLaws :: (Applicative f, Applicative g, Bitraversable p,+                           Eq (g (p c c)), Eq (p a b), Eq (p d e), Eq1 f)                        => (a -> f c) -> (b -> f c) -> (c -> f d) -> (c -> f e)                        -> (forall x. f x -> g x) -> p a b -> Bool prop_BitraversableLaws f g h i t x =