[commit: packages/containers] cleaned_bugfix394, master, revert-408-bugfix_394: LiftA2 some more, etc. (#399) (71833cf)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/containers

On branches: cleaned_bugfix394,master,revert-408-bugfix_394
Link       : http://git.haskell.org/packages/containers.git/commitdiff/71833cf44e7a8c584f03ccf8eae1cec2d93c2c26

>---------------------------------------------------------------

commit 71833cf44e7a8c584f03ccf8eae1cec2d93c2c26
Author: David Feuer <David.Feuer at gmail.com>
Date:   Wed Feb 8 20:31:33 2017 -0500

    LiftA2 some more, etc. (#399)
    
    * Define custom `<$`, `liftA2`, `<*`, and `*>` for `Data.Tree`.
    
    * Use `liftA2` as appropriate in `Data.Tree` and `Data.Graph`.


>---------------------------------------------------------------

71833cf44e7a8c584f03ccf8eae1cec2d93c2c26
 Data/Graph.hs |  4 ++--
 Data/Tree.hs  | 18 ++++++++++++++++--
 2 files changed, 18 insertions(+), 4 deletions(-)

diff --git a/Data/Graph.hs b/Data/Graph.hs
index ab9e24f..c7f5497 100644
--- a/Data/Graph.hs
+++ b/Data/Graph.hs
@@ -80,8 +80,8 @@ import qualified Data.IntSet as Set
 import Data.Tree (Tree(Node), Forest)
 
 -- std interfaces
-#if !MIN_VERSION_base(4,8,0)
 import Control.Applicative
+#if !MIN_VERSION_base(4,8,0)
 import qualified Data.Foldable as F
 import Data.Traversable
 #else
@@ -157,7 +157,7 @@ instance Traversable SCC where
   traverse f (AcyclicSCC vertex) = AcyclicSCC <$> f vertex
   traverse _f (CyclicSCC []) = pure (CyclicSCC [])
   traverse f (CyclicSCC (x : xs)) =
-    (\x' xs' -> CyclicSCC (x' : xs')) <$> f x <*> traverse f xs
+    liftA2 (\x' xs' -> CyclicSCC (x' : xs')) (f x) (traverse f xs)
 
 instance NFData a => NFData (SCC a) where
     rnf (AcyclicSCC v) = rnf v
diff --git a/Data/Tree.hs b/Data/Tree.hs
index bf567d8..83e70e0 100644
--- a/Data/Tree.hs
+++ b/Data/Tree.hs
@@ -38,8 +38,9 @@ module Data.Tree(
 
 #if MIN_VERSION_base(4,8,0)
 import Data.Foldable (toList)
+import Control.Applicative (Applicative(..), liftA2)
 #else
-import Control.Applicative (Applicative(..), (<$>))
+import Control.Applicative (Applicative(..), liftA2, (<$>))
 import Data.Foldable (Foldable(foldMap), toList)
 import Data.Monoid (Monoid(..))
 import Data.Traversable (Traversable(traverse))
@@ -73,6 +74,10 @@ import Data.Functor.Classes
 import Data.Semigroup (Semigroup (..))
 #endif
 
+#if !MIN_VERSION_base(4,8,0)
+import Data.Functor ((<$))
+#endif
+
 -- | Multi-way trees, also known as /rose trees/.
 data Tree a = Node {
         rootLabel :: a,         -- ^ label value
@@ -128,6 +133,7 @@ INSTANCE_TYPEABLE1(Tree)
 
 instance Functor Tree where
     fmap = fmapTree
+    x <$ Node _ ts = Node x (map (x <$) ts)
 
 fmapTree :: (a -> b) -> Tree a -> Tree b
 fmapTree f (Node x ts) = Node (f x) (map (fmapTree f) ts)
@@ -144,6 +150,14 @@ instance Applicative Tree where
     pure x = Node x []
     Node f tfs <*> tx@(Node x txs) =
         Node (f x) (map (f <$>) txs ++ map (<*> tx) tfs)
+#if MIN_VERSION_base(4,10,0)
+    liftA2 f (Node x txs) ty@(Node y tys) =
+        Node (f x y) (map (f x <$>) tys ++ map (\tx -> liftA2 f tx ty) txs)
+#endif
+    Node x txs <* ty@(Node _ tys) =
+        Node x (map (x <$) tys ++ map (<* ty) txs)
+    Node _ txs *> ty@(Node y tys) =
+        Node y (tys ++ map (*> ty) txs)
 
 instance Monad Tree where
     return = pure
@@ -151,7 +165,7 @@ instance Monad Tree where
       where Node x' ts' = f x
 
 instance Traversable Tree where
-    traverse f (Node x ts) = Node <$> f x <*> traverse (traverse f) ts
+    traverse f (Node x ts) = liftA2 Node (f x) (traverse (traverse f) ts)
 
 instance Foldable Tree where
     foldMap f (Node x ts) = f x `mappend` foldMap (foldMap f) ts