[commit: packages/containers] cleaned_bugfix394, master, merge-doc-target, merge-fixes-5.9, merge-restrict-fix-5.8, revert-408-bugfix_394: Add lookup and (!?) to Data.Sequence (e60c648)

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

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

commit e60c64814d9553a57d12786d584988bc83a4f105
Author: David Feuer <David.Feuer at gmail.com>
Date:   Sun May 29 22:12:16 2016 -0400

    Add lookup and (!?) to Data.Sequence
    
    Also improve the QuickCheck properties for `chunksOf` and
    `insertAt`, and add pattern synonym documentation.


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

e60c64814d9553a57d12786d584988bc83a4f105
 Data/Sequence.hs        | 38 +++++++++++++++++++++++++++++++++++++-
 changelog.md            |  4 ++--
 tests/seq-properties.hs | 34 +++++++++++++++++++---------------
 3 files changed, 58 insertions(+), 18 deletions(-)

diff --git a/Data/Sequence.hs b/Data/Sequence.hs
index 46ae543..5457f7f 100644
--- a/Data/Sequence.hs
+++ b/Data/Sequence.hs
@@ -145,6 +145,8 @@ module Data.Sequence (
     unstableSort,   -- :: Ord a => Seq a -> Seq a
     unstableSortBy, -- :: (a -> a -> Ordering) -> Seq a -> Seq a
     -- * Indexing
+    lookup,         -- :: Int -> Seq a -> Maybe a
+    (!?),           -- :: Seq a -> Int -> Maybe a
     index,          -- :: Seq a -> Int -> a
     adjust,         -- :: (a -> a) -> Int -> Seq a -> Seq a
     update,         -- :: Int -> a -> Seq a -> Seq a
@@ -194,7 +196,7 @@ import Prelude hiding (
 #if MIN_VERSION_base(4,8,0)
     Applicative, (<$>), foldMap, Monoid,
 #endif
-    null, length, take, drop, splitAt, foldl, foldl1, foldr, foldr1,
+    null, length, lookup, take, drop, splitAt, foldl, foldl1, foldr, foldr1,
     scanl, scanl1, scanr, scanr1, replicate, zip, zipWith, zip3, zipWith3,
     takeWhile, dropWhile, iterate, reverse, filter, mapM, sum, all)
 import qualified Data.List
@@ -282,8 +284,11 @@ infixl 5 :|>
 -- Unfortunately, there's some extra noise here because
 -- pattern synonyms could not have signatures until 7.10,
 -- but 8.0 at least will warn if they're missing.
+
+-- | A pattern synonym matching an empty sequence.
 #if __GLASGOW_HASKELL__ >= 710
 pattern Empty :: Seq a
+#else
 #endif
 pattern Empty = Seq EmptyT
 
@@ -291,6 +296,8 @@ pattern Empty = Seq EmptyT
 -- available in GHC >= 7.10. In earlier versions, these
 -- can be used to match, but not to construct.
 
+-- | A pattern synonym viewing the front of a non-empty
+-- sequence.
 #if __GLASGOW_HASKELL__ >= 710
 pattern (:<|) :: a -> Seq a -> Seq a
 #endif
@@ -300,6 +307,8 @@ pattern x :<| xs <- (viewl -> x :< xs)
     x :<| xs = x <| xs
 #endif
 
+-- | A pattern synonym viewing the rear of a non-empty
+-- sequence.
 #if __GLASGOW_HASKELL__ >= 710
 pattern (:|>) :: Seq a -> a -> Seq a
 #endif
@@ -1589,6 +1598,8 @@ scanr1 f xs = case viewr xs of
 -- counting from 0.  The argument should thus be a non-negative
 -- integer less than the size of the sequence.
 -- If the position is out of range, 'index' fails with an error.
+--
+-- prop> xs `index` i = toList xs !! i
 index           :: Seq a -> Int -> a
 index (Seq xs) i
   -- See note on unsigned arithmetic in splitAt
@@ -1596,6 +1607,31 @@ index (Seq xs) i
                 Place _ (Elem x) -> x
   | otherwise   = error "index out of bounds"
 
+-- | /O(log(min(i,n-i)))/. The element at the specified position,
+-- counting from 0. If the specified position is negative or at
+-- least the length of the sequence, 'lookup' returns 'Nothing'.
+--
+-- prop> 0 <= i < length xs ==> lookup i xs == Just (toList xs !! i)
+-- prop> i < 0 || i >= length xs ==> lookup i xs = Nothing
+--
+-- @since 0.5.8
+lookup            :: Int -> Seq a -> Maybe a
+lookup i (Seq xs)
+  -- Note: we perform the lookup *before* applying the Just constructor
+  -- to ensure that we don't hold a reference to the whole sequence in
+  -- a thunk. If we applied the Just constructor around the case, the
+  -- actual lookup wouldn't be performed unless and until the value was
+  -- forced.
+  | fromIntegral i < (fromIntegral (size xs) :: Word) = case lookupTree i xs of
+                Place _ (Elem x) -> Just x
+  | otherwise = Nothing
+
+-- | /O(log(min(i,n-i)))/. A flipped, infix version of `lookup`.
+--
+-- @since 0.5.8
+(!?) ::           Seq a -> Int -> Maybe a
+(!?) = flip lookup
+
 data Place a = Place {-# UNPACK #-} !Int a
 #if TESTING
     deriving Show
diff --git a/changelog.md b/changelog.md
index af5f88c..6a755ce 100644
--- a/changelog.md
+++ b/changelog.md
@@ -22,8 +22,8 @@
 
   * Add `Empty`, `:<|`, and `:|>` pattern synonyms for `Data.Sequence`.
 
-  * Add `chunksOf`, `cycleN`, `insertAt`, `intersperse`, `foldMapWithIndex`, and
-    `traverseWithIndex` for `Data.Sequence`.
+  * Add (!?), `lookup`, `chunksOf`, `cycleN`, `insertAt`, `intersperse`,
+    `foldMapWithIndex`, and `traverseWithIndex` for `Data.Sequence`.
 
   * Make `splitAt` in `Data.Sequence` strict in its arguments. Previously,
     it returned a lazy pair.
diff --git a/tests/seq-properties.hs b/tests/seq-properties.hs
index 1a72312..2b9745b 100644
--- a/tests/seq-properties.hs
+++ b/tests/seq-properties.hs
@@ -10,7 +10,7 @@ import Data.Maybe
 import Data.Monoid (Monoid(..), All(..), Endo(..), Dual(..))
 import Data.Traversable (Traversable(traverse), sequenceA)
 import Prelude hiding (
-  null, length, take, drop, splitAt,
+  lookup, null, length, take, drop, splitAt,
   foldl, foldl1, foldr, foldr1, scanl, scanl1, scanr, scanr1,
   filter, reverse, replicate, zip, zipWith, zip3, zipWith3,
   all, sum)
@@ -72,6 +72,7 @@ main = defaultMain
        , testProperty "unstableSort" prop_unstableSort
        , testProperty "unstableSortBy" prop_unstableSortBy
        , testProperty "index" prop_index
+       , testProperty "(!?)" prop_safeIndex
        , testProperty "adjust" prop_adjust
        , testProperty "insertAt" prop_insertAt
        , testProperty "update" prop_update
@@ -482,14 +483,17 @@ prop_index xs =
     not (null xs) ==> forAll (choose (0, length xs-1)) $ \ i ->
     index xs i == toList xs !! i
 
--- We take an element and a sequence, and make sure we can insert
--- the element anywhere in or near the sequence.
+prop_safeIndex :: Seq A -> Property
+prop_safeIndex xs =
+    forAll (choose (-3, length xs + 3)) $ \i ->
+    ((i < 0 || i >= length xs) .&&. lookup i xs === Nothing) .||.
+    lookup i xs === Just (toList xs !! i)
+
 prop_insertAt :: A -> Seq A -> Property
-prop_insertAt x xs = conjoin [insertAt_index i | i <- [(-3)..(length xs + 3)]]
-  where
-    insertAt_index i =
-      valid res .&&. res === case splitAt i xs of (front, back) -> front >< x <| back
-         where res = insertAt i x xs
+prop_insertAt x xs =
+  forAll (choose (-3, length xs + 3)) $ \i ->
+      let res = insertAt i x xs
+      in valid res .&&. res === case splitAt i xs of (front, back) -> front >< x <| back
 
 prop_adjust :: Int -> Int -> Seq Int -> Bool
 prop_adjust n i xs =
@@ -512,13 +516,13 @@ 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))
+prop_chunksOf :: Seq A -> Property
+prop_chunksOf xs =
+  forAll (choose (1, length xs + 3)) $ \n ->
+    let chunks = chunksOf n xs
+    in valid chunks .&&.
+       conjoin [valid c .&&. 1 <= length c && length c <= n | c <- toList chunks] .&&.
+       fold chunks === xs
 
 adjustList :: (a -> a) -> Int -> [a] -> [a]
 adjustList f i xs =