[commit: packages/containers] cleaned_bugfix394, master, merge-doc-target, merge-fixes-5.9, revert-408-bugfix_394: Actually expose Data.Sequence pattern synonyms (5f316c4)

[git at git.haskell.org]

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

On branches: cleaned_bugfix394,master,merge-doc-target,merge-fixes-5.9,revert-408-bugfix_394
Link       : http://git.haskell.org/packages/containers.git/commitdiff/5f316c4dd6daa5f1b42dba0d513f527d4e89de61

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

commit 5f316c4dd6daa5f1b42dba0d513f527d4e89de61
Author: David Feuer <David.Feuer at gmail.com>
Date:   Mon Sep 5 12:14:51 2016 -0400

    Actually expose Data.Sequence pattern synonyms
    
    * Expose `Data.Sequence` pattern synonyms for real.
    
    * Add tests for the pattern synonyms.
    
    * Kill a couple silly warnings in `Data.Map.Internal`.


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

5f316c4dd6daa5f1b42dba0d513f527d4e89de61
 Data/Map/Internal.hs      |  4 ++--
 Data/Sequence/Internal.hs |  6 +-----
 include/containers.h      |  4 ++++
 tests/seq-properties.hs   | 52 +++++++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 59 insertions(+), 7 deletions(-)

diff --git a/Data/Map/Internal.hs b/Data/Map/Internal.hs
index 8ed1d08..7d09eb9 100644
--- a/Data/Map/Internal.hs
+++ b/Data/Map/Internal.hs
@@ -3322,7 +3322,7 @@ fromAscList xs
         (x:xx) -> combineEq' x xx
 
   combineEq' z [] = [z]
-  combineEq' z@(kz,zz) (x@(kx,xx):xs')
+  combineEq' z@(kz,_) (x@(kx,xx):xs')
     | kx==kz    = combineEq' (kx,xx) xs'
     | otherwise = z:combineEq' x xs'
 #if __GLASGOW_HASKELL__
@@ -3348,7 +3348,7 @@ fromDescList xs = fromDistinctDescList (combineEq xs)
         (x:xx) -> combineEq' x xx
 
   combineEq' z [] = [z]
-  combineEq' z@(kz,zz) (x@(kx,xx):xs')
+  combineEq' z@(kz,_) (x@(kx,xx):xs')
     | kx==kz    = combineEq' (kx,xx) xs'
     | otherwise = z:combineEq' x xs'
 #if __GLASGOW_HASKELL__
diff --git a/Data/Sequence/Internal.hs b/Data/Sequence/Internal.hs
index 40a7fc9..95c143e 100644
--- a/Data/Sequence/Internal.hs
+++ b/Data/Sequence/Internal.hs
@@ -1,8 +1,6 @@
 {-# LANGUAGE CPP #-}
+#include "containers.h"
 {-# LANGUAGE BangPatterns #-}
-#if __GLASGOW_HASKELL__ >= 800
-#define DEFINE_PATTERN_SYNONYMS 1
-#endif
 #if __GLASGOW_HASKELL__
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE StandaloneDeriving #-}
@@ -23,8 +21,6 @@
 {-# LANGUAGE ViewPatterns #-}
 #endif
 
-#include "containers.h"
-
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Sequence.Internal
diff --git a/include/containers.h b/include/containers.h
index 273c1b2..83cea82 100644
--- a/include/containers.h
+++ b/include/containers.h
@@ -29,6 +29,10 @@
 #define INSTANCE_TYPEABLE2(tycon)
 #endif
 
+#if __GLASGOW_HASKELL__ >= 800
+#define DEFINE_PATTERN_SYNONYMS 1
+#endif
+
 /*
  * We use cabal-generated MIN_VERSION_base to adapt to changes of base.
  * Nevertheless, as a convenience, we also allow compiling without cabal by
diff --git a/tests/seq-properties.hs b/tests/seq-properties.hs
index ca2f627..f325f3f 100644
--- a/tests/seq-properties.hs
+++ b/tests/seq-properties.hs
@@ -1,4 +1,18 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE PatternGuards #-}
+
 import Data.Sequence.Internal
+  ( Sized (..)
+  , Seq (Seq)
+  , FingerTree(..)
+  , Node(..)
+  , Elem(..)
+  , Digit (..)
+  , node2
+  , node3
+  , deep )
+
+import Data.Sequence
 
 import Control.Applicative (Applicative(..))
 import Control.Arrow ((***))
@@ -18,6 +32,9 @@ import qualified Prelude
 import qualified Data.List
 import Test.QuickCheck hiding ((><))
 import Test.QuickCheck.Poly
+#if __GLASGOW_HASKELL__ >= 800
+import Test.QuickCheck.Property
+#endif
 import Test.QuickCheck.Function
 import Test.Framework
 import Test.Framework.Providers.QuickCheck2
@@ -109,6 +126,14 @@ main = defaultMain
        , testProperty "cycleTaking" prop_cycleTaking
        , testProperty "intersperse" prop_intersperse
        , testProperty ">>=" prop_bind
+#if __GLASGOW_HASKELL__ >= 800
+       , testProperty "Empty pattern" prop_empty_pat
+       , testProperty "Empty constructor" prop_empty_con
+       , testProperty "Left view pattern" prop_viewl_pat
+       , testProperty "Left view constructor" prop_viewl_con
+       , testProperty "Right view pattern" prop_viewr_pat
+       , testProperty "Right view constructor" prop_viewr_con
+#endif
        ]
 
 ------------------------------------------------------------------------
@@ -679,6 +704,33 @@ prop_cycleTaking :: Int -> Seq A -> Property
 prop_cycleTaking n xs =
     (n <= 0 || not (null xs)) ==> toList' (cycleTaking n xs) ~= Data.List.take n (Data.List.cycle (toList xs))
 
+#if __GLASGOW_HASKELL__ >= 800
+prop_empty_pat :: Seq A -> Bool
+prop_empty_pat xs at Empty = null xs
+prop_empty_pat xs = not (null xs)
+
+prop_empty_con :: Bool
+prop_empty_con = null Empty
+
+prop_viewl_pat :: Seq A -> Property
+prop_viewl_pat xs@(y :<| ys)
+  | z :< zs <- viewl xs = y === z .&&. ys === zs
+  | otherwise = property failed
+prop_viewl_pat xs = property . liftBool $ null xs
+
+prop_viewl_con :: A -> Seq A -> Property
+prop_viewl_con x xs = x :<| xs === x <| xs
+
+prop_viewr_pat :: Seq A -> Property
+prop_viewr_pat xs@(ys :|> y)
+  | zs :> z <- viewr xs = y === z .&&. ys === zs
+  | otherwise = property failed
+prop_viewr_pat xs = property . liftBool $ null xs
+
+prop_viewr_con :: Seq A -> A -> Property
+prop_viewr_con xs x = xs :|> x === xs |> x
+#endif
+
 -- Monad operations
 
 prop_bind :: Seq A -> Fun A (Seq B) -> Bool