[commit: packages/containers] cleaned_bugfix394, master, merge-doc-target, merge-fixes-5.9, merge-restrict-fix-5.8, revert-408-bugfix_394: Add chunksOf to Data.Sequence (32d1ba3)

[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/32d1ba300729ebe5cdfbde12ab0b73e03fb9bf3f

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

commit 32d1ba300729ebe5cdfbde12ab0b73e03fb9bf3f
Author: David Feuer <David.Feuer at gmail.com>
Date:   Sun Mar 15 20:50:40 2015 -0400

    Add chunksOf to Data.Sequence
    
    Break up a sequence into pieces of a given size. Based on
    `Data.List.Split.chunksOf` and implemented using `splitMap`.
    
    Also add an appropriate QuickCheck property.


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

32d1ba300729ebe5cdfbde12ab0b73e03fb9bf3f
 Data/Sequence.hs        | 20 ++++++++++++++++----
 tests/seq-properties.hs | 13 +++++++++++--
 2 files changed, 27 insertions(+), 6 deletions(-)

diff --git a/Data/Sequence.hs b/Data/Sequence.hs
index b42a5b2..95029e3 100644
--- a/Data/Sequence.hs
+++ b/Data/Sequence.hs
@@ -126,6 +126,7 @@ module Data.Sequence (
     -- * Sublists
     tails,          -- :: Seq a -> Seq (Seq a)
     inits,          -- :: Seq a -> Seq (Seq a)
+    chunksOf,       -- :: Int -> Seq a -> Seq (Seq a)
     -- ** Sequential searches
     takeWhileL,     -- :: (a -> Bool) -> Seq a -> Seq a
     takeWhileR,     -- :: (a -> Bool) -> Seq a -> Seq a
@@ -2271,10 +2272,9 @@ splitAt' i (Seq xs)      = case splitTreeE i xs of
 -- enhance sharing when the split point is less than or equal to 0, and that
 -- gives completely wrong answers when the split point is at least the length
 -- of the sequence, unless the sequence is a singleton. This is used to
--- implement zipWith, which hits the first case at most once, only hits the
--- second with singletons, and is extremely sensitive to the cost of splitting
--- very short sequences. There is just enough of a speed increase to make this
--- worth the trouble.
+-- implement zipWith and chunksOf, which are extremely sensitive to the cost of
+-- splitting very short sequences. There is just enough of a speed increase to
+-- make this worth the trouble.
 uncheckedSplitAt :: Int -> Seq a -> (Seq a, Seq a)
 uncheckedSplitAt i (Seq xs) = case splitTreeE i xs of
   l :*: r -> (Seq l, Seq r)
@@ -2435,6 +2435,18 @@ splitSuffixN i s pr m (Four a b c d)
     scd     = size c + sd
     sbcd    = size b + scd
 
+-- | /O(n)/. @chunksOf n xs@ splits @xs@ into chunks of size @n>0 at .
+-- If @n@ does not divide the length of @xs@ evenly, then the last element
+-- of the result will be short.
+chunksOf :: Int -> Seq a -> Seq (Seq a)
+chunksOf n _ | n <= 0 = error "chunksOf takes a positive integer argument"
+chunksOf 1 s = fmap singleton s
+chunksOf n s = splitMap (uncheckedSplitAt . (*n)) const most (replicate numReps ())
+                 >< if null end then empty else singleton end
+  where
+    (numReps, endLength) = length s `quotRem` n
+    (most, end) = splitAt' (length s - endLength) s
+
 -- | /O(n)/.  Returns a sequence of all suffixes of this sequence,
 -- longest first.  For example,
 --
diff --git a/tests/seq-properties.hs b/tests/seq-properties.hs
index f9fb071..e075a4e 100644
--- a/tests/seq-properties.hs
+++ b/tests/seq-properties.hs
@@ -4,10 +4,10 @@ import Control.Applicative (Applicative(..))
 import Control.Arrow ((***))
 import Control.Monad.Trans.State.Strict
 import Data.Array (listArray)
-import Data.Foldable (Foldable(foldl, foldl1, foldr, foldr1, foldMap), toList, all, sum)
+import Data.Foldable (Foldable(foldl, foldl1, foldr, foldr1, foldMap, fold), toList, all, sum)
 import Data.Functor ((<$>), (<$))
 import Data.Maybe
-import Data.Monoid (Monoid(..))
+import Data.Monoid (Monoid(..), All (..))
 import Data.Traversable (Traversable(traverse), sequenceA)
 import Prelude hiding (
   null, length, take, drop, splitAt,
@@ -77,6 +77,7 @@ main = defaultMain
        , testProperty "take" prop_take
        , testProperty "drop" prop_drop
        , testProperty "splitAt" prop_splitAt
+       , testProperty "chunksOf" prop_chunksOf
        , testProperty "elemIndexL" prop_elemIndexL
        , testProperty "elemIndicesL" prop_elemIndicesL
        , testProperty "elemIndexR" prop_elemIndexR
@@ -499,6 +500,14 @@ prop_splitAt :: Int -> Seq A -> Bool
 prop_splitAt n xs =
     toListPair' (splitAt n xs) ~= Prelude.splitAt n (toList xs)
 
+prop_chunksOf :: Positive Int -> Seq A -> Bool
+prop_chunksOf (Positive n') xs =
+    valid chunks &&
+    getAll (foldMap (All . (\c -> valid c && length c <= n)) chunks) &&
+    fold chunks == xs
+  where chunks = chunksOf n xs
+        n = max 1 (n' `rem` (length xs + 3))
+
 adjustList :: (a -> a) -> Int -> [a] -> [a]
 adjustList f i xs =
     [if j == i then f x else x | (j, x) <- Prelude.zip [0..] xs]