LiftA2 some more, etc. (#399)

* Define custom `<$`, `liftA2`, `<*`, and `*>` for `Data.Tree`.

* Use `liftA2` as appropriate in `Data.Tree` and `Data.Graph`.

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

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,14 +150,22 @@ 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
     Node x ts >>= f = Node x' (ts' ++ map (>>= f) ts)
       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