[commit: packages/containers] cleaned_bugfix394, master, merge-doc-target, merge-fixes-5.9, merge-restrict-fix-5.8, revert-408-bugfix_394: Make `intersperse` work right up to the edge (#276) (af1e36e)

[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/af1e36e5fd48ef4111e00f607dbcc794071d79b0

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

commit af1e36e5fd48ef4111e00f607dbcc794071d79b0
Author: David Feuer <David.Feuer at gmail.com>
Date:   Tue May 31 13:29:20 2016 -0400

    Make `intersperse` work right up to the edge (#276)
    
    Previously, `intersperse` would fail if passed a sequence of
    length
    
    ```haskell
    ((maxBound :: Int) `quot` 2) + 1
    ```
    
    Now it should be able to produce results of lengths right up to
    `maxBound :: Int`.


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

af1e36e5fd48ef4111e00f607dbcc794071d79b0
 Data/Sequence.hs | 13 ++++++++++++-
 1 file changed, 12 insertions(+), 1 deletion(-)

diff --git a/Data/Sequence.hs b/Data/Sequence.hs
index 2899fc3..11c0ca8 100644
--- a/Data/Sequence.hs
+++ b/Data/Sequence.hs
@@ -640,7 +640,18 @@ thin12 s pr m (Four a b c d) = DeepTh s pr (thin $ m `snocTree` node2 a b) (Two1
 --
 -- @since 0.5.8
 intersperse :: a -> Seq a -> Seq a
-intersperse y xs = drop 1 $ xs <**> (const y <| singleton id)
+intersperse y xs = case viewl xs of
+  EmptyL -> empty
+  p :< ps -> p <| (ps <**> (const y <| singleton id))
+-- We used to use
+--
+-- intersperse y xs = drop 1 $ xs <**> (const y <| singleton id)
+--
+-- but if length xs = ((maxBound :: Int) `quot` 2) + 1 then
+--
+-- length (xs <**> (const y <| singleton id)) will wrap around to negative
+-- and the drop won't work. The new implementation can produce a result
+-- right up to maxBound :: Int
 
 instance MonadPlus Seq where
     mzero = empty