[commit: packages/containers] cleaned_bugfix394, master, merge-doc-target, merge-fixes-5.9, merge-restrict-fix-5.8, revert-408-bugfix_394: Make traverse fmap less (2726d15)

[git at git.haskell.org]

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

On branches: cleaned_bugfix394,master,merge-doc-target,merge-fixes-5.9,merge-restrict-fix-5.8,revert-408-bugfix_394
Link       : http://git.haskell.org/packages/containers.git/commitdiff/2726d15e6f66e0c1b863075655841d040d6fa540

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

commit 2726d15e6f66e0c1b863075655841d040d6fa540
Author: David Feuer <David.Feuer at gmail.com>
Date:   Fri Jun 10 00:42:11 2016 -0400

    Make traverse fmap less
    
    Use safe coercions to avoid `fmap` at the leaves to deal with
    `Elem` and at the root to deal with `Seq`. This should speed
    things up for non-trivial functors.


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

2726d15e6f66e0c1b863075655841d040d6fa540
 Data/Sequence.hs | 21 +++++++++++++++++++++
 1 file changed, 21 insertions(+)

diff --git a/Data/Sequence.hs b/Data/Sequence.hs
index 82afd61..0bd3bbe 100644
--- a/Data/Sequence.hs
+++ b/Data/Sequence.hs
@@ -404,8 +404,29 @@ instance Foldable Seq where
     {-# INLINE null #-}
 #endif
 
+#if __GLASGOW_HASKELL__ >= 708
+-- The natural definition of traverse, used for implementations that don't
+-- support coercions, `fmap`s into each `Elem`, then `fmap`s again over the
+-- result to turn it from a `FingerTree` to a `Seq`. None of this mapping is
+-- necessary! We could avoid it without coercions, I believe, by writing a
+-- bunch of traversal functions to deal with the `Elem` stuff specially (for
+-- FingerTrees, Digits, and Nodes), but using coercions we only need to
+-- duplicate code at the FingerTree level. We coerce the `Seq a` to a
+-- `FingerTree a`, stripping off all the Elem junk, then use a weird FingerTree
+-- traversing function that coerces back to Seq within the functor.
+instance Traversable Seq where
+    traverse f (Seq xs) = traverseFTE f (coerce xs)
+
+traverseFTE :: Applicative f => (a -> f b) -> FingerTree a -> f (Seq b)
+traverseFTE _f EmptyT = pure empty
+traverseFTE f (Single x) = Seq . Single . Elem <$> f x
+traverseFTE f (Deep s pr m sf) =
+  (\pr' m' sf' -> coerce $ Deep s pr' m' sf') <$>
+     traverse f pr <*> traverse (traverse f) m <*> traverse f sf
+#else
 instance Traversable Seq where
     traverse f (Seq xs) = Seq <$> traverse (traverse f) xs
+#endif
 
 instance NFData a => NFData (Seq a) where
     rnf (Seq xs) = rnf xs