packages feed

containers 0.5.11.0 → 0.6.0.1

raw patch · 45 files changed

+1761/−1040 lines, 45 filesdep ~arraydep ~basedep ~test-frameworkPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: array, base, test-framework, test-framework-quickcheck2

API changes (from Hackage documentation)

- Data.IntMap.Internal: instance Data.Semigroup.Semigroup (Data.IntMap.Internal.IntMap a)
- Data.IntSet.Internal: instance Data.Semigroup.Semigroup Data.IntSet.Internal.IntSet
- Data.Map.Internal: instance GHC.Classes.Ord k => Data.Semigroup.Semigroup (Data.Map.Internal.Map k v)
- Data.Sequence.Internal: instance Data.Semigroup.Semigroup (Data.Sequence.Internal.Seq a)
- Data.Sequence.Internal: instance a ~ GHC.Types.Char => Data.String.IsString (Data.Sequence.Internal.Seq a)
- Data.Set.Internal: instance Data.Semigroup.Semigroup (Data.Set.Internal.MergeSet a)
- Data.Set.Internal: instance GHC.Classes.Ord a => Data.Semigroup.Semigroup (Data.Set.Internal.Set a)
+ Data.Containers.ListUtils: nubInt :: [Int] -> [Int]
+ Data.Containers.ListUtils: nubIntOn :: (a -> Int) -> [a] -> [a]
+ Data.Containers.ListUtils: nubOrd :: Ord a => [a] -> [a]
+ Data.Containers.ListUtils: nubOrdOn :: Ord b => (a -> b) -> [a] -> [a]
+ Data.Graph: Node :: a -> Forest a -> Tree a
+ Data.Graph: data Tree a
+ Data.Graph: type Forest a = [Tree a]
+ Data.IntMap.Internal: instance GHC.Base.Semigroup (Data.IntMap.Internal.IntMap a)
+ Data.IntSet.Internal: instance GHC.Base.Semigroup Data.IntSet.Internal.IntSet
+ Data.Map.Internal: instance GHC.Classes.Ord k => GHC.Base.Semigroup (Data.Map.Internal.Map k v)
+ Data.Sequence.Internal: instance (a ~ GHC.Types.Char) => Data.String.IsString (Data.Sequence.Internal.Seq a)
+ Data.Sequence.Internal: instance GHC.Base.Semigroup (Data.Sequence.Internal.Seq a)
+ Data.Sequence.Internal: instance GHC.Generics.Generic (Data.Sequence.Internal.Digit a)
+ Data.Sequence.Internal: instance GHC.Generics.Generic (Data.Sequence.Internal.Elem a)
+ Data.Sequence.Internal: instance GHC.Generics.Generic (Data.Sequence.Internal.FingerTree a)
+ Data.Sequence.Internal: instance GHC.Generics.Generic (Data.Sequence.Internal.Node a)
+ Data.Sequence.Internal: instance GHC.Generics.Generic1 Data.Sequence.Internal.Digit
+ Data.Sequence.Internal: instance GHC.Generics.Generic1 Data.Sequence.Internal.Elem
+ Data.Sequence.Internal: instance GHC.Generics.Generic1 Data.Sequence.Internal.FingerTree
+ Data.Sequence.Internal: instance GHC.Generics.Generic1 Data.Sequence.Internal.Node
+ Data.Set.Internal: instance GHC.Base.Semigroup (Data.Set.Internal.MergeSet a)
+ Data.Set.Internal: instance GHC.Classes.Ord a => GHC.Base.Semigroup (Data.Set.Internal.Set a)
- Data.Graph: indegree :: Graph -> Table Int
+ Data.Graph: indegree :: Graph -> Array Vertex Int
- Data.Graph: outdegree :: Graph -> Table Int
+ Data.Graph: outdegree :: Graph -> Array Vertex Int
- Data.Graph: type Graph = Table [Vertex]
+ Data.Graph: type Graph = Array Vertex [Vertex]
- Data.IntMap: fold :: (a -> b -> b) -> b -> IntMap a -> b
+ Data.IntMap: fold :: Whoops "Data.IntMap.fold' is gone. Use Data.IntMap.foldr or Prelude.foldr." => (a -> b -> b) -> b -> IntMap a -> b
- Data.IntMap: foldWithKey :: (Key -> a -> b -> b) -> b -> IntMap a -> b
+ Data.IntMap: foldWithKey :: Whoops "Data.IntMap.foldWithKey is gone. Use foldrWithKey." => (Key -> a -> b -> b) -> b -> IntMap a -> b
- Data.IntMap: insertWith' :: (a -> a -> a) -> Key -> a -> IntMap a -> IntMap a
+ Data.IntMap: insertWith' :: Whoops "Data.IntMap.insertWith' is gone. Use Data.IntMap.Strict.insertWith." => (a -> a -> a) -> Key -> a -> IntMap a -> IntMap a
- Data.IntMap: insertWithKey' :: (Key -> a -> a -> a) -> Key -> a -> IntMap a -> IntMap a
+ Data.IntMap: insertWithKey' :: Whoops "Data.IntMap.insertWithKey' is gone. Use Data.IntMap.Strict.insertWithKey." => (Key -> a -> a -> a) -> Key -> a -> IntMap a -> IntMap a
- Data.IntMap.Internal: WhenMatched :: (Key -> x -> y -> f (Maybe z)) -> WhenMatched f x y z
+ Data.IntMap.Internal: WhenMatched :: Key -> x -> y -> f (Maybe z) -> WhenMatched f x y z
- Data.IntMap.Internal: WhenMissing :: (IntMap x -> f (IntMap y)) -> (Key -> x -> f (Maybe y)) -> WhenMissing f x y
+ Data.IntMap.Internal: WhenMissing :: IntMap x -> f (IntMap y) -> Key -> x -> f (Maybe y) -> WhenMissing f x y
- Data.IntMap.Internal: unions :: [IntMap a] -> IntMap a
+ Data.IntMap.Internal: unions :: Foldable f => f (IntMap a) -> IntMap a
- Data.IntMap.Internal: unionsWith :: (a -> a -> a) -> [IntMap a] -> IntMap a
+ Data.IntMap.Internal: unionsWith :: Foldable f => (a -> a -> a) -> f (IntMap a) -> IntMap a
- Data.IntMap.Lazy: showTree :: Show a => IntMap a -> String
+ Data.IntMap.Lazy: showTree :: Whoops "Data.IntMap.showTree has moved to Data.IntMap.Internal.Debug.showTree" => IntMap a -> String
- Data.IntMap.Lazy: showTreeWith :: Show a => Bool -> Bool -> IntMap a -> String
+ Data.IntMap.Lazy: showTreeWith :: Whoops "Data.IntMap.showTreeWith has moved to Data.IntMap.Internal.Debug.showTreeWith" => Bool -> Bool -> IntMap a -> String
- Data.IntMap.Lazy: unions :: [IntMap a] -> IntMap a
+ Data.IntMap.Lazy: unions :: Foldable f => f (IntMap a) -> IntMap a
- Data.IntMap.Lazy: unionsWith :: (a -> a -> a) -> [IntMap a] -> IntMap a
+ Data.IntMap.Lazy: unionsWith :: Foldable f => (a -> a -> a) -> f (IntMap a) -> IntMap a
- Data.IntMap.Strict: showTree :: Show a => IntMap a -> String
+ Data.IntMap.Strict: showTree :: Whoops "Data.IntMap.showTree has moved to Data.IntMap.Internal.Debug.showTree" => IntMap a -> String
- Data.IntMap.Strict: showTreeWith :: Show a => Bool -> Bool -> IntMap a -> String
+ Data.IntMap.Strict: showTreeWith :: Whoops "Data.IntMap.showTreeWith has moved to Data.IntMap.Internal.Debug.showTreeWith" => Bool -> Bool -> IntMap a -> String
- Data.IntMap.Strict: unions :: [IntMap a] -> IntMap a
+ Data.IntMap.Strict: unions :: Foldable f => f (IntMap a) -> IntMap a
- Data.IntMap.Strict: unionsWith :: (a -> a -> a) -> [IntMap a] -> IntMap a
+ Data.IntMap.Strict: unionsWith :: Foldable f => (a -> a -> a) -> f (IntMap a) -> IntMap a
- Data.IntSet: unions :: [IntSet] -> IntSet
+ Data.IntSet: unions :: Foldable f => f IntSet -> IntSet
- Data.IntSet.Internal: unions :: [IntSet] -> IntSet
+ Data.IntSet.Internal: unions :: Foldable f => f IntSet -> IntSet
- Data.Map: fold :: (a -> b -> b) -> b -> Map k a -> b
+ Data.Map: fold :: Whoops "Data.Map.fold is gone. Use foldr." => (a -> b -> b) -> b -> Map k a -> b
- Data.Map: foldWithKey :: (k -> a -> b -> b) -> b -> Map k a -> b
+ Data.Map: foldWithKey :: Whoops "Data.Map.foldWithKey is gone. Use foldrWithKey." => (k -> a -> b -> b) -> b -> Map k a -> b
- Data.Map: insertLookupWithKey' :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> (Maybe a, Map k a)
+ Data.Map: insertLookupWithKey' :: Whoops "Data.Map.insertLookupWithKey' is gone. Use Data.Map.Strict.insertLookupWithKey." => (k -> a -> a -> a) -> k -> a -> Map k a -> (Maybe a, Map k a)
- Data.Map: insertWith' :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
+ Data.Map: insertWith' :: Whoops "Data.Map.insertWith' is gone. Use Data.Map.Strict.insertWith." => (a -> a -> a) -> k -> a -> Map k a -> Map k a
- Data.Map: insertWithKey' :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
+ Data.Map: insertWithKey' :: Whoops "Data.Map.insertWithKey' is gone. Use Data.Map.Strict.insertWithKey." => (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
- Data.Map.Internal: WhenMatched :: (k -> x -> y -> f (Maybe z)) -> WhenMatched f k x y z
+ Data.Map.Internal: WhenMatched :: k -> x -> y -> f (Maybe z) -> WhenMatched f k x y z
- Data.Map.Internal: WhenMissing :: (Map k x -> f (Map k y)) -> (k -> x -> f (Maybe y)) -> WhenMissing f k x y
+ Data.Map.Internal: WhenMissing :: Map k x -> f (Map k y) -> k -> x -> f (Maybe y) -> WhenMissing f k x y
- Data.Map.Internal: newtype Identity a :: * -> *
+ Data.Map.Internal: newtype Identity a
- Data.Map.Internal: unions :: Ord k => [Map k a] -> Map k a
+ Data.Map.Internal: unions :: (Foldable f, Ord k) => f (Map k a) -> Map k a
- Data.Map.Internal: unionsWith :: Ord k => (a -> a -> a) -> [Map k a] -> Map k a
+ Data.Map.Internal: unionsWith :: (Foldable f, Ord k) => (a -> a -> a) -> f (Map k a) -> Map k a
- Data.Map.Lazy: showTree :: (Show k, Show a) => Map k a -> String
+ Data.Map.Lazy: showTree :: Whoops "showTree has moved to Data.Map.Internal.Debug.showTree." => Map k a -> String
- Data.Map.Lazy: showTreeWith :: (k -> a -> String) -> Bool -> Bool -> Map k a -> String
+ Data.Map.Lazy: showTreeWith :: Whoops "showTreeWith has moved to Data.Map.Internal.Debug.showTreeWith." => (k -> a -> String) -> Bool -> Bool -> Map k a -> String
- Data.Map.Lazy: unions :: Ord k => [Map k a] -> Map k a
+ Data.Map.Lazy: unions :: (Foldable f, Ord k) => f (Map k a) -> Map k a
- Data.Map.Lazy: unionsWith :: Ord k => (a -> a -> a) -> [Map k a] -> Map k a
+ Data.Map.Lazy: unionsWith :: (Foldable f, Ord k) => (a -> a -> a) -> f (Map k a) -> Map k a
- Data.Map.Strict: showTree :: (Show k, Show a) => Map k a -> String
+ Data.Map.Strict: showTree :: Whoops "showTree has moved to Data.Map.Internal.Debug.showTree." => Map k a -> String
- Data.Map.Strict: showTreeWith :: (k -> a -> String) -> Bool -> Bool -> Map k a -> String
+ Data.Map.Strict: showTreeWith :: Whoops "showTreeWith has moved to Data.Map.Internal.Debug.showTreeWith." => (k -> a -> String) -> Bool -> Bool -> Map k a -> String
- Data.Map.Strict: unions :: Ord k => [Map k a] -> Map k a
+ Data.Map.Strict: unions :: (Foldable f, Ord k) => f (Map k a) -> Map k a
- Data.Map.Strict: unionsWith :: Ord k => (a -> a -> a) -> [Map k a] -> Map k a
+ Data.Map.Strict: unionsWith :: (Foldable f, Ord k) => (a -> a -> a) -> f (Map k a) -> Map k a
- Data.Map.Strict.Internal: WhenMatched :: (k -> x -> y -> f (Maybe z)) -> WhenMatched f k x y z
+ Data.Map.Strict.Internal: WhenMatched :: k -> x -> y -> f (Maybe z) -> WhenMatched f k x y z
- Data.Map.Strict.Internal: WhenMissing :: (Map k x -> f (Map k y)) -> (k -> x -> f (Maybe y)) -> WhenMissing f k x y
+ Data.Map.Strict.Internal: WhenMissing :: Map k x -> f (Map k y) -> k -> x -> f (Maybe y) -> WhenMissing f k x y
- Data.Map.Strict.Internal: showTree :: (Show k, Show a) => Map k a -> String
+ Data.Map.Strict.Internal: showTree :: Whoops "showTree has moved to Data.Map.Internal.Debug.showTree." => Map k a -> String
- Data.Map.Strict.Internal: showTreeWith :: (k -> a -> String) -> Bool -> Bool -> Map k a -> String
+ Data.Map.Strict.Internal: showTreeWith :: Whoops "showTreeWith has moved to Data.Map.Internal.Debug.showTreeWith." => (k -> a -> String) -> Bool -> Bool -> Map k a -> String
- Data.Map.Strict.Internal: unions :: Ord k => [Map k a] -> Map k a
+ Data.Map.Strict.Internal: unions :: (Foldable f, Ord k) => f (Map k a) -> Map k a
- Data.Map.Strict.Internal: unionsWith :: Ord k => (a -> a -> a) -> [Map k a] -> Map k a
+ Data.Map.Strict.Internal: unionsWith :: (Foldable f, Ord k) => (a -> a -> a) -> f (Map k a) -> Map k a
- Data.Sequence.Internal: State :: (s -> (s, a)) -> State s a
+ Data.Sequence.Internal: State :: s -> (s, a) -> State s a
- Data.Set: unions :: Ord a => [Set a] -> Set a
+ Data.Set: unions :: (Foldable f, Ord a) => f (Set a) -> Set a
- Data.Set.Internal: unions :: Ord a => [Set a] -> Set a
+ Data.Set.Internal: unions :: (Foldable f, Ord a) => f (Set a) -> Set a

Files

+ Data/Containers/ListUtils.hs view
@@ -0,0 +1,181 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE BangPatterns #-}+#ifdef __GLASGOW_HASKELL__+{-# LANGUAGE Trustworthy #-}+#endif++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Containers.ListUtils+-- Copyright   :  (c) Gershom Bazerman 2018+-- License     :  BSD-style+-- Maintainer  :  libraries@haskell.org+-- Portability :  portable+--+-- This module provides efficient containers-based functions on the list type.+-----------------------------------------------------------------------------++module Data.Containers.ListUtils (+       nubOrd,+       nubOrdOn,+       nubInt,+       nubIntOn+       ) where++import Data.Set (Set)+import qualified Data.Set as Set+import qualified Data.IntSet as IntSet+import Data.IntSet (IntSet)+#ifdef __GLASGOW_HASKELL__+import GHC.Exts ( build )+#endif++-- *** Ord-based nubbing ***+++-- | \( O(n \log n \). The @nubOrd@ function removes duplicate elements from a list.+-- In particular, it keeps only the first occurrence of each element. By using a+-- 'Set' internally it has better asymptotics than the standard 'Data.List.nub'+-- function.+--+-- ==== Strictness+--+-- @nubOrd@ is strict in the elements of the list.+--+-- ==== Efficiency note+--+-- When applicable, it is almost always better to use 'nubInt' or 'nubIntOn' instead+-- of this function. For example, the best way to nub a list of characters is+--+-- @ nubIntOn fromEnum xs @+nubOrd :: Ord a => [a] -> [a]+nubOrd = nubOrdOn id+{-# INLINE nubOrd #-}++-- | The @nubOrdOn@ function behaves just like 'nubOrd' except it performs+-- comparisons not on the original datatype, but a user-specified projection+-- from that datatype.+--+-- ==== Strictness+--+-- @nubOrdOn@ is strict in the values of the function applied to the+-- elements of the list.+nubOrdOn :: Ord b => (a -> b) -> [a] -> [a]+-- For some reason we need to write an explicit lambda here to allow this+-- to inline when only applied to a function.+nubOrdOn f = \xs -> nubOrdOnExcluding f Set.empty xs+{-# INLINE nubOrdOn #-}++-- Splitting nubOrdOn like this means that we don't have to worry about+-- matching specifically on Set.empty in the rewrite-back rule.+nubOrdOnExcluding :: Ord b => (a -> b) -> Set b -> [a] -> [a]+nubOrdOnExcluding f = go+  where+    go _ [] = []+    go s (x:xs)+      | fx `Set.member` s = go s xs+      | otherwise = x : go (Set.insert fx s) xs+      where !fx = f x++#ifdef __GLASGOW_HASKELL__+-- We want this inlinable to specialize to the necessary Ord instance.+{-# INLINABLE [1] nubOrdOnExcluding #-}++{-# RULES+-- Rewrite to a fusible form.+"nubOrdOn" [~1] forall f as s. nubOrdOnExcluding  f s as =+  build (\c n -> foldr (nubOrdOnFB f c) (constNubOn n) as s)++-- Rewrite back to a plain form+"nubOrdOnList" [1] forall f as s.+    foldr (nubOrdOnFB f (:)) (constNubOn []) as s =+       nubOrdOnExcluding f s as+ #-}++nubOrdOnFB :: Ord b+           => (a -> b)+           -> (a -> r -> r)+           -> a+           -> (Set b -> r)+           -> Set b+           -> r+nubOrdOnFB f c x r s+  | fx `Set.member` s = r s+  | otherwise = x `c` r (Set.insert fx s)+  where !fx = f x+{-# INLINABLE [0] nubOrdOnFB #-}++constNubOn :: a -> b -> a+constNubOn x _ = x+{-# INLINE [0] constNubOn #-}+#endif+++-- *** Int-based nubbing ***+++-- | \( O(n \min(n,W)) \). The @nubInt@ function removes duplicate 'Int'+-- values from a list. In particular, it keeps only the first occurrence+-- of each element. By using an 'IntSet' internally, it attains better+-- asymptotics than the standard 'Data.List.nub' function.+--+-- See also 'nubIntOn', a more widely applicable generalization.+--+-- ==== Strictness+--+-- @nubInt@ is strict in the elements of the list.+nubInt :: [Int] -> [Int]+nubInt = nubIntOn id+{-# INLINE nubInt #-}++-- | The @nubIntOn@ function behaves just like 'nubInt' except it performs+-- comparisons not on the original datatype, but a user-specified projection+-- from that datatype.+--+-- ==== Strictness+--+-- @nubIntOn@ is strict in the values of the function applied to the+-- elements of the list.+nubIntOn :: (a -> Int) -> [a] -> [a]+-- For some reason we need to write an explicit lambda here to allow this+-- to inline when only applied to a function.+nubIntOn f = \xs -> nubIntOnExcluding f IntSet.empty xs+{-# INLINE nubIntOn #-}++-- Splitting nubIntOn like this means that we don't have to worry about+-- matching specifically on IntSet.empty in the rewrite-back rule.+nubIntOnExcluding :: (a -> Int) -> IntSet -> [a] -> [a]+nubIntOnExcluding f = go+  where+    go _ [] = []+    go s (x:xs)+      | fx `IntSet.member` s = go s xs+      | otherwise = x : go (IntSet.insert fx s) xs+      where !fx = f x++#ifdef __GLASGOW_HASKELL__+-- We don't mark this INLINABLE because it doesn't seem obviously useful+-- to inline it anywhere; the elements the function operates on are actually+-- pulled from a list and installed in a list; the situation is very different+-- when fusion occurs. In this case, we let GHC make the call.+{-# NOINLINE [1] nubIntOnExcluding #-}++{-# RULES+"nubIntOn" [~1] forall f as s. nubIntOnExcluding  f s as =+  build (\c n -> foldr (nubIntOnFB f c) (constNubOn n) as s)+"nubIntOnList" [1] forall f as s. foldr (nubIntOnFB f (:)) (constNubOn []) as s =+  nubIntOnExcluding f s as+ #-}++nubIntOnFB :: (a -> Int)+           -> (a -> r -> r)+           -> a+           -> (IntSet -> r)+           -> IntSet+           -> r+nubIntOnFB f c x r s+  | fx `IntSet.member` s = r s+  | otherwise = x `c` r (IntSet.insert fx s)+  where !fx = f x+{-# INLINABLE [0] nubIntOnFB #-}+#endif
Data/Graph.hs view
@@ -1,15 +1,14 @@ {-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__-{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE StandaloneDeriving #-}-#endif-#if __GLASGOW_HASKELL__ >= 703-{-# LANGUAGE Trustworthy #-}-#endif-#if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StandaloneDeriving #-}+# if __GLASGOW_HASKELL__ >= 710+{-# LANGUAGE Safe #-}+# else+{-# LANGUAGE Trustworthy #-}+# endif #endif  #include "containers.h"@@ -23,56 +22,82 @@ -- Maintainer  :  libraries@haskell.org -- Portability :  portable ----- A version of the graph algorithms described in:+-- = Finite Graphs -----   /Structuring Depth-First Search Algorithms in Haskell/,---   by David King and John Launchbury.+-- The @'Graph'@ type is an adjacency list representation of a finite, directed+-- graph with vertices of type @Int@. --+-- The @'SCC'@ type represents a+-- <https://en.wikipedia.org/wiki/Strongly_connected_component strongly-connected component>+-- of a graph.+--+-- == Implementation+--+-- The implementation is based on+--+--   * /Structuring Depth-First Search Algorithms in Haskell/,+--     by David King and John Launchbury.+-- ----------------------------------------------------------------------------- -module Data.Graph(+module Data.Graph ( -        -- * External interface+    -- * Graphs+      Graph+    , Bounds+    , Edge+    , Vertex+    , Table -        -- At present the only one with a "nice" external interface-        stronglyConnComp, stronglyConnCompR, SCC(..), flattenSCC, flattenSCCs,+    -- ** Graph Construction+    , graphFromEdges+    , graphFromEdges'+    , buildG -        -- * Graphs+    -- ** Graph Properties+    , vertices+    , edges+    , outdegree+    , indegree -        Graph, Table, Bounds, Edge, Vertex,+    -- ** Graph Transformations+    , transposeG -        -- ** Building graphs+    -- ** Graph Algorithms+    , dfs+    , dff+    , topSort+    , components+    , scc+    , bcc+    , reachable+    , path -        graphFromEdges, graphFromEdges', buildG, transposeG,-        -- reverseE, -        -- ** Graph properties--        vertices, edges,-        outdegree, indegree,+    -- * Strongly Connected Components+    , SCC(..) -        -- * Algorithms+    -- ** Construction+    , stronglyConnComp+    , stronglyConnCompR -        dfs, dff,-        topSort,-        components,-        scc,-        bcc,-        -- tree, back, cross, forward,-        reachable, path,+    -- ** Conversion+    , flattenSCC+    , flattenSCCs -        module Data.Tree+    -- * Trees+    , module Data.Tree      ) where -#if __GLASGOW_HASKELL__-# define USE_ST_MONAD 1-#endif---- Extensions #if USE_ST_MONAD import Control.Monad.ST-import Data.Array.ST (STArray, newArray, readArray, writeArray)+import Data.Array.ST.Safe (newArray, readArray, writeArray)+# if USE_UNBOXED_ARRAYS+import Data.Array.ST.Safe (STUArray)+# else+import Data.Array.ST.Safe (STArray)+# endif #else import Data.IntSet (IntSet) import qualified Data.IntSet as Set@@ -90,25 +115,29 @@ import Control.DeepSeq (NFData(rnf)) import Data.Maybe import Data.Array+#if USE_UNBOXED_ARRAYS+import qualified Data.Array.Unboxed as UA+import Data.Array.Unboxed ( UArray )+#else+import qualified Data.Array as UA+#endif import Data.List #if MIN_VERSION_base(4,9,0) import Data.Functor.Classes import Data.Semigroup (Semigroup (..)) #endif-#if __GLASGOW_HASKELL__ >= 706-import GHC.Generics (Generic, Generic1)-#elif __GLASGOW_HASKELL__ >= 702-import GHC.Generics (Generic)-#endif #ifdef __GLASGOW_HASKELL__+import GHC.Generics (Generic, Generic1) import Data.Data (Data)-#endif import Data.Typeable+#endif +-- Make sure we don't use Integer by mistake.+default ()  ------------------------------------------------------------------------- --                                                                      ----      External interface+--      Strongly Connected Components --                                                                      - ------------------------------------------------------------------------- @@ -131,14 +160,10 @@ #ifdef __GLASGOW_HASKELL__ -- | @since 0.5.9 deriving instance Data vertex => Data (SCC vertex)-#endif -#if __GLASGOW_HASKELL__ >= 706 -- | @since 0.5.9 deriving instance Generic1 SCC-#endif -#if __GLASGOW_HASKELL__ >= 702 -- | @since 0.5.9 deriving instance Generic (SCC vertex) #endif@@ -246,31 +271,59 @@ -- | Abstract representation of vertices. type Vertex  = Int -- | Table indexed by a contiguous set of vertices.+--+-- /Note: This is included for backwards compatibility./ type Table a = Array Vertex a -- | Adjacency list representation of a graph, mapping each vertex to its -- list of successors.-type Graph   = Table [Vertex]--- | The bounds of a 'Table'.+type Graph   = Array Vertex [Vertex]+-- | The bounds of an @Array@. type Bounds  = (Vertex, Vertex) -- | An edge from the first vertex to the second. type Edge    = (Vertex, Vertex) --- | All vertices of a graph.+#if !USE_UNBOXED_ARRAYS+type UArray i a = Array i a+#endif++-- | Returns the list of vertices in the graph.+--+-- ==== __Examples__+--+-- > vertices (buildG (0,-1) []) == []+--+-- > vertices (buildG (0,2) [(0,1),(1,2)]) == [0,1,2] vertices :: Graph -> [Vertex] vertices  = indices --- | All edges of a graph.+-- | Returns the list of edges in the graph.+--+-- ==== __Examples__+--+-- > edges (buildG (0,-1) []) == []+--+-- > edges (buildG (0,2) [(0,1),(1,2)]) == [(0,1),(1,2)] edges    :: Graph -> [Edge] edges g   = [ (v, w) | v <- vertices g, w <- g!v ] -mapT    :: (Vertex -> a -> b) -> Table a -> Table b-mapT f t = array (bounds t) [ (,) v (f v (t!v)) | v <- indices t ]- -- | Build a graph from a list of edges.+--+-- Warning: This function will cause a runtime exception if a vertex in the edge+-- list is not within the given @Bounds@.+--+-- ==== __Examples__+--+-- > buildG (0,-1) [] == array (0,-1) []+-- > buildG (0,2) [(0,1), (1,2)] == array (0,1) [(0,[1]),(1,[2])]+-- > buildG (0,2) [(0,1), (0,2), (1,2)] == array (0,2) [(0,[2,1]),(1,[2]),(2,[])] buildG :: Bounds -> [Edge] -> Graph buildG bounds0 edges0 = accumArray (flip (:)) [] bounds0 edges0  -- | The graph obtained by reversing all edges.+--+-- ==== __Examples__+--+-- > transposeG (buildG (0,2) [(0,1), (1,2)]) == array (0,2) [(0,[]),(1,[0]),(2,[1])] transposeG  :: Graph -> Graph transposeG g = buildG (bounds g) (reverseE g) @@ -278,13 +331,28 @@ reverseE g   = [ (w, v) | (v, w) <- edges g ]  -- | A table of the count of edges from each node.-outdegree :: Graph -> Table Int-outdegree  = mapT numEdges-             where numEdges _ ws = length ws+--+-- ==== __Examples__+--+-- > outdegree (buildG (0,-1) []) == array (0,-1) []+--+-- > outdegree (buildG (0,2) [(0,1), (1,2)]) == array (0,2) [(0,1),(1,1),(2,0)]+outdegree :: Graph -> Array Vertex Int+-- This is bizarrely lazy. We build an array filled with thunks, instead+-- of actually calculating anything. This is the historical behavior, and I+-- suppose someone *could* be relying on it, but it might be worth finding+-- out. Note that we *can't* be so lazy with indegree.+outdegree  = fmap length  -- | A table of the count of edges into each node.-indegree :: Graph -> Table Int-indegree  = outdegree . transposeG+--+-- ==== __Examples__+--+-- > indegree (buildG (0,-1) []) == array (0,-1) []+--+-- > indegree (buildG (0,2) [(0,1), (1,2)]) == array (0,2) [(0,0),(1,1),(2,1)]+indegree :: Graph -> Array Vertex Int+indegree g = accumArray (+) 0 (bounds g) [(v, 1) | (_, outs) <- assocs g, v <- outs]  -- | Identical to 'graphFromEdges', except that the return value -- does not include the function which maps keys to vertices.  This@@ -298,8 +366,60 @@  -- | Build a graph from a list of nodes uniquely identified by keys, -- with a list of keys of nodes this node should have edges to.--- The out-list may contain keys that don't correspond to--- nodes of the graph; they are ignored.+--+-- This function takes an adjacency list representing a graph with vertices of+-- type @key@ labeled by values of type @node@ and produces a @Graph@-based+-- representation of that list. The @Graph@ result represents the /shape/ of the+-- graph, and the functions describe a) how to retrieve the label and adjacent+-- vertices of a given vertex, and b) how to retrive a vertex given a key.+--+-- @(graph, nodeFromVertex, vertexFromKey) = graphFromEdges edgeList@+--+-- * @graph :: Graph@ is the raw, array based adjacency list for the graph.+-- * @nodeFromVertex :: Vertex -> (node, key, [key])@ returns the node+--   associated with the given 0-based @Int@ vertex; see /warning/ below.+-- * @vertexFromKey :: key -> Maybe Vertex@ returns the @Int@ vertex for the+--   key if it exists in the graph, @Nothing@ otherwise.+--+-- To safely use this API you must either extract the list of vertices directly+-- from the graph or first call @vertexFromKey k@ to check if a vertex+-- corresponds to the key @k@. Once it is known that a vertex exists you can use+-- @nodeFromVertex@ to access the labelled node and adjacent vertices. See below+-- for examples.+--+-- Note: The out-list may contain keys that don't correspond to nodes of the+-- graph; they are ignored.+--+-- Warning: The @nodeFromVertex@ function will cause a runtime exception if the+-- given @Vertex@ does not exist.+--+-- ==== __Examples__+--+-- An empty graph.+--+-- > (graph, nodeFromVertex, vertexFromKey) = graphFromEdges []+-- > graph = array (0,-1) []+--+-- A graph where the out-list references unspecified nodes (@'c'@), these are+-- ignored.+--+-- > (graph, _, _) = graphFromEdges [("a", 'a', ['b']), ("b", 'b', ['c'])]+-- > array (0,1) [(0,[1]),(1,[])]+--+--+-- A graph with 3 vertices: ("a") -> ("b") -> ("c")+--+-- > (graph, nodeFromVertex, vertexFromKey) = graphFromEdges [("a", 'a', ['b']), ("b", 'b', ['c']), ("c", 'c', [])]+-- > graph == array (0,2) [(0,[1]),(1,[2]),(2,[])]+-- > nodeFromVertex 0 == ("a",'a',"b")+-- > vertexFromKey 'a' == Just 0+--+-- Get the label for a given key.+--+-- > let getNodePart (n, _, _) = n+-- > (graph, nodeFromVertex, vertexFromKey) = graphFromEdges [("a", 'a', ['b']), ("b", 'b', ['c']), ("c", 'c', [])]+-- > getNodePart . nodeFromVertex <$> vertexFromKey 'a' == Just "A"+-- graphFromEdges         :: Ord key         => [(node, key, [key])]@@ -372,7 +492,11 @@  -- Use the ST monad if available, for constant-time primitives. -newtype SetM s a = SetM { runSetM :: STArray s Vertex Bool -> ST s a }+#if USE_UNBOXED_ARRAYS+newtype SetM s a = SetM { runSetM :: STUArray s Vertex Bool -> ST s a }+#else+newtype SetM s a = SetM { runSetM :: STArray  s Vertex Bool -> ST s a }+#endif  instance Monad (SetM s) where     return = pure@@ -452,10 +576,14 @@ preorderF :: Forest a -> [a] preorderF ts = preorderF' ts [] -tabulate        :: Bounds -> [Vertex] -> Table Int-tabulate bnds vs = array bnds (zipWith (,) vs [1..])+tabulate        :: Bounds -> [Vertex] -> UArray Vertex Int+tabulate bnds vs = UA.array bnds (zipWith (flip (,)) [1..] vs)+-- Why zipWith (flip (,)) instead of just using zip with the+-- arguments in the other order? We want the [1..] to fuse+-- away, and these days that only happens when it's the first+-- list argument. -preArr          :: Bounds -> Forest Vertex -> Table Int+preArr          :: Bounds -> Forest Vertex -> UArray Vertex Int preArr bnds      = tabulate bnds . preorderF  ------------------------------------------------------------@@ -519,18 +647,35 @@ forward           :: Graph -> Graph -> Table Int -> Graph forward g tree' pre = mapT select g  where select v ws = [ w | w <- ws, pre!v < pre!w ] \\ tree' ! v++mapT    :: (Vertex -> a -> b) -> Array Vertex a -> Array Vertex b+mapT f t = array (bounds t) [ (,) v (f v (t!v)) | v <- indices t ] -}  ------------------------------------------------------------ -- Algorithm 6: Finding reachable vertices ------------------------------------------------------------ --- | A list of vertices reachable from a given vertex.-reachable    :: Graph -> Vertex -> [Vertex]+-- | Returns the list of vertices reachable from a given vertex.+--+-- ==== __Examples__+--+-- > reachable (buildG (0,0) []) 0 == [0]+--+-- > reachable (buildG (0,2) [(0,1), (1,2)]) 0 == [0,1,2]+reachable :: Graph -> Vertex -> [Vertex] reachable g v = preorderF (dfs g [v]) --- | Is the second vertex reachable from the first?-path         :: Graph -> Vertex -> Vertex -> Bool+-- | Returns @True@ if the second vertex reachable from the first.+--+-- ==== __Examples__+--+-- > path (buildG (0,0) []) 0 0 == True+--+-- > path (buildG (0,2) [(0,1), (1,2)]) 0 2 == True+--+-- > path (buildG (0,2) [(0,1), (1,2)]) 2 0 == False+path :: Graph -> Vertex -> Vertex -> Bool path g v w    = w `elem` (reachable g v)  ------------------------------------------------------------@@ -545,10 +690,10 @@  where forest = dff g        dnum   = preArr (bounds g) forest -do_label :: Graph -> Table Int -> Tree Vertex -> Tree (Vertex,Int,Int)-do_label g dnum (Node v ts) = Node (v,dnum!v,lv) us+do_label :: Graph -> UArray Vertex Int -> Tree Vertex -> Tree (Vertex,Int,Int)+do_label g dnum (Node v ts) = Node (v, dnum UA.! v, lv) us  where us = map (do_label g dnum) ts-       lv = minimum ([dnum!v] ++ [dnum!w | w <- g!v]+       lv = minimum ([dnum UA.! v] ++ [dnum UA.! w | w <- g!v]                      ++ [lu | Node (_,_,lu) _ <- us])  bicomps :: Tree (Vertex,Int,Int) -> Forest [Vertex]
Data/IntMap.hs view
@@ -1,7 +1,13 @@ {-# LANGUAGE CPP #-}-#if !defined(TESTING) && __GLASGOW_HASKELL__ >= 703+#if !defined(TESTING) && defined(__GLASGOW_HASKELL__) {-# LANGUAGE Safe #-} #endif+#ifdef __GLASGOW_HASKELL__+{-# LANGUAGE DataKinds, FlexibleContexts #-}+#endif+#if __GLASGOW_HASKELL__ >= 800+{-# LANGUAGE MonoLocalBinds #-}+#endif  #include "containers.h" @@ -54,43 +60,42 @@  module Data.IntMap     ( module Data.IntMap.Lazy+#ifdef __GLASGOW_HASKELL__+-- For GHC, we disable these, pending removal. For anything else,+-- we just don't define them at all.     , insertWith'     , insertWithKey'     , fold     , foldWithKey+#endif     ) where -import Prelude ()  -- hide foldr-import qualified Data.IntMap.Strict as Strict import Data.IntMap.Lazy --- | /O(log n)/. Same as 'insertWith', but the result of the combining function--- is evaluated to WHNF before inserted to the map.--{-# DEPRECATED insertWith' "As of version 0.5, replaced by 'Data.IntMap.Strict.insertWith'." #-}-insertWith' :: (a -> a -> a) -> Key -> a -> IntMap a -> IntMap a-insertWith' = Strict.insertWith---- | /O(log n)/. Same as 'insertWithKey', but the result of the combining--- function is evaluated to WHNF before inserted to the map.+#ifdef __GLASGOW_HASKELL__+import Utils.Containers.Internal.TypeError -{-# DEPRECATED insertWithKey' "As of version 0.5, replaced by 'Data.IntMap.Strict.insertWithKey'." #-}-insertWithKey' :: (Key -> a -> a -> a) -> Key -> a -> IntMap a -> IntMap a-insertWithKey' = Strict.insertWithKey+-- | This function is being removed and is no longer usable.+-- Use 'Data.IntMap.Strict.insertWith'+insertWith' :: Whoops "Data.IntMap.insertWith' is gone. Use Data.IntMap.Strict.insertWith."+            => (a -> a -> a) -> Key -> a -> IntMap a -> IntMap a+insertWith' _ _ _ _ = undefined --- | /O(n)/. Fold the values in the map using the given--- right-associative binary operator. This function is an equivalent--- of 'foldr' and is present for compatibility only.-{-# DEPRECATED fold "As of version 0.5, replaced by 'foldr'." #-}-fold :: (a -> b -> b) -> b -> IntMap a -> b-fold = foldr-{-# INLINE fold #-}+-- | This function is being removed and is no longer usable.+-- Use 'Data.IntMap.Strict.insertWithKey'.+insertWithKey' :: Whoops "Data.IntMap.insertWithKey' is gone. Use Data.IntMap.Strict.insertWithKey."+               => (Key -> a -> a -> a) -> Key -> a -> IntMap a -> IntMap a+insertWithKey' _ _ _ _ = undefined --- | /O(n)/. Fold the keys and values in the map using the given--- right-associative binary operator. This function is an equivalent--- of 'foldrWithKey' and is present for compatibility only.+-- | This function is being removed and is no longer usable.+-- Use 'Data.IntMap.Lazy.foldr'.+fold :: Whoops "Data.IntMap.fold' is gone. Use Data.IntMap.foldr or Prelude.foldr."+     => (a -> b -> b) -> b -> IntMap a -> b+fold _ _ _ = undefined -{-# DEPRECATED foldWithKey "As of version 0.5, replaced by 'foldrWithKey'." #-}-foldWithKey :: (Key -> a -> b -> b) -> b -> IntMap a -> b-foldWithKey = foldrWithKey-{-# INLINE foldWithKey #-}+-- | This function is being removed and is no longer usable.+-- Use 'foldrWithKey'.+foldWithKey :: Whoops "Data.IntMap.foldWithKey is gone. Use foldrWithKey."+            => (Key -> a -> b -> b) -> b -> IntMap a -> b+foldWithKey _ _ _ = undefined+#endif
Data/IntMap/Internal.hs view
@@ -5,7 +5,7 @@ {-# LANGUAGE MagicHash, DeriveDataTypeable, StandaloneDeriving #-} {-# LANGUAGE ScopedTypeVariables #-} #endif-#if !defined(TESTING) && __GLASGOW_HASKELL__ >= 703+#if !defined(TESTING) && defined(__GLASGOW_HASKELL__) {-# LANGUAGE Trustworthy #-} #endif #if __GLASGOW_HASKELL__ >= 708@@ -303,6 +303,7 @@ import Control.DeepSeq (NFData(rnf)) import Data.Bits import qualified Data.Foldable as Foldable+import Data.Foldable (Foldable()) import Data.Maybe (fromMaybe) import Data.Typeable import Prelude hiding (lookup, map, filter, foldr, foldl, null)@@ -310,7 +311,6 @@ import Data.IntSet.Internal (Key) import qualified Data.IntSet.Internal as IntSet import Utils.Containers.Internal.BitUtil-import Utils.Containers.Internal.StrictFold import Utils.Containers.Internal.StrictPair  #if __GLASGOW_HASKELL__@@ -444,13 +444,10 @@           go (Tip _ v) = f v           go (Bin _ _ l r) = go l `mappend` go r   {-# INLINE foldMap #-}--#if MIN_VERSION_base(4,6,0)   foldl' = foldl'   {-# INLINE foldl' #-}   foldr' = foldr'   {-# INLINE foldr' #-}-#endif #if MIN_VERSION_base(4,8,0)   length = size   {-# INLINE length #-}@@ -1003,18 +1000,18 @@ -- > unions [(fromList [(5, "A3"), (3, "B3")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "a"), (3, "b")])] -- >     == fromList [(3, "B3"), (5, "A3"), (7, "C")] -unions :: [IntMap a] -> IntMap a+unions :: Foldable f => f (IntMap a) -> IntMap a unions xs-  = foldlStrict union empty xs+  = Foldable.foldl' union empty xs  -- | The union of a list of maps, with a combining operation. -- -- > unionsWith (++) [(fromList [(5, "a"), (3, "b")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "A3"), (3, "B3")])] -- >     == fromList [(3, "bB3"), (5, "aAA3"), (7, "C")] -unionsWith :: (a->a->a) -> [IntMap a] -> IntMap a+unionsWith :: Foldable f => (a->a->a) -> f (IntMap a) -> IntMap a unionsWith f ts-  = foldlStrict (unionWith f) empty ts+  = Foldable.foldl' (unionWith f) empty ts  -- | /O(n+m)/. The (left-biased) union of two maps. -- It prefers the first map when duplicate keys are encountered,@@ -1082,7 +1079,7 @@ -- | /O(n+m)/. Remove all the keys in a given set from a map. -- -- @--- m `withoutKeys` s = 'filterWithKey' (\k _ -> k `'IntSet.notMember'` s) m+-- m \`withoutKeys\` s = 'filterWithKey' (\k _ -> k ``IntSet.notMember`` s) m -- @ -- -- @since 0.5.8@@ -1160,7 +1157,7 @@ -- | /O(n+m)/. The restriction of a map to the keys in a set. -- -- @--- m `restrictKeys` s = 'filterWithKey' (\k _ -> k `'IntSet.member'` s) m+-- m \`restrictKeys\` s = 'filterWithKey' (\k _ -> k ``IntSet.member`` s) m -- @ -- -- @since 0.5.8@@ -3031,7 +3028,7 @@  fromList :: [(Key,a)] -> IntMap a fromList xs-  = foldlStrict ins empty xs+  = Foldable.foldl' ins empty xs   where     ins t (k,x)  = insert k x t @@ -3052,7 +3049,7 @@  fromListWithKey :: (Key -> a -> a -> a) -> [(Key,a)] -> IntMap a fromListWithKey f xs-  = foldlStrict ins empty xs+  = Foldable.foldl' ins empty xs   where     ins t (k,x) = insertWithKey f k x t 
Data/IntMap/Internal/DeprecatedDebug.hs view
@@ -1,20 +1,17 @@+{-# LANGUAGE CPP, FlexibleContexts, DataKinds, MonoLocalBinds #-}+ module Data.IntMap.Internal.DeprecatedDebug where-import qualified Data.IntMap.Internal as IM import Data.IntMap.Internal (IntMap) -{-# DEPRECATED showTree, showTreeWith-    "These debugging functions will be removed from this module. They are available from Data.IntMap.Internal.Debug."-    #-}+import Utils.Containers.Internal.TypeError --- | /O(n)/. Show the tree that implements the map. The tree is shown--- in a compressed, hanging format.-showTree :: Show a => IntMap a -> String-showTree = IM.showTree -{- | /O(n)/. The expression (@'showTreeWith' hang wide map@) shows- the tree that implements the map. If @hang@ is- 'True', a /hanging/ tree is shown otherwise a rotated tree is shown. If- @wide@ is 'True', an extra wide version is shown.--}-showTreeWith :: Show a => Bool -> Bool -> IntMap a -> String-showTreeWith = IM.showTreeWith+-- | 'showTree' has moved to 'Data.IntMap.Internal.Debug.showTree'+showTree :: Whoops "Data.IntMap.showTree has moved to Data.IntMap.Internal.Debug.showTree"+         => IntMap a -> String+showTree _ = undefined++-- | 'showTreeWith' has moved to 'Data.IntMap.Internal.Debug.showTreeWith'+showTreeWith :: Whoops "Data.IntMap.showTreeWith has moved to Data.IntMap.Internal.Debug.showTreeWith"+             => Bool -> Bool -> IntMap a -> String+showTreeWith _ _ _ = undefined
Data/IntMap/Lazy.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE CPP #-}-#if !defined(TESTING) && __GLASGOW_HASKELL__ >= 703+#if !defined(TESTING) && defined(__GLASGOW_HASKELL__) {-# LANGUAGE Safe #-} #endif @@ -14,26 +14,47 @@ -- Maintainer  :  libraries@haskell.org -- Portability :  portable ----- An efficient implementation of maps from integer keys to values--- (dictionaries). ----- API of this module is strict in the keys, but lazy in the values.--- If you need value-strict maps, use "Data.IntMap.Strict" instead.--- The 'IntMap' type itself is shared between the lazy and strict modules,--- meaning that the same 'IntMap' value can be passed to functions in--- both modules (although that is rarely needed).+-- = Finite Int Maps (lazy interface) ----- These modules are intended to be imported qualified, to avoid name--- clashes with Prelude functions, e.g.+-- The @'IntMap' v@ type represents a finite map (sometimes called a dictionary)+-- from keys of type @Int@ to values of type @v@. ----- >  import Data.IntMap.Lazy (IntMap)--- >  import qualified Data.IntMap.Lazy as IntMap+-- The functions in "Data.IntMap.Strict" are careful to force values before+-- installing them in an 'IntMap'. This is usually more efficient in cases where+-- laziness is not essential. The functions in this module do not do so. --+-- For a walkthrough of the most commonly used functions see the+-- <https://haskell-containers.readthedocs.io/en/latest/map.html maps introduction>.+--+-- This module is intended to be imported qualified, to avoid name clashes with+-- Prelude functions:+--+-- > import Data.IntMap.Lazy (IntMap)+-- > import qualified Data.IntMap.Lazy as IntMap+--+-- Note that the implementation is generally /left-biased/. Functions that take+-- two maps as arguments and combine them, such as `union` and `intersection`,+-- prefer the values in the first argument to those in the second.+--+--+-- == Detailed performance information+--+-- The amortized running time is given for each operation, with /n/ referring to+-- the number of entries in the map and /W/ referring to the number of bits in+-- an 'Int' (32 or 64).+--+-- Benchmarks comparing "Data.IntMap.Lazy" with other dictionary+-- implementations can be found at https://github.com/haskell-perf/dictionaries.+--+--+-- == Implementation+-- -- The implementation is based on /big-endian patricia trees/.  This data--- structure performs especially well on binary operations like 'union'--- and 'intersection'.  However, my benchmarks show that it is also--- (much) faster on insertions and deletions when compared to a generic--- size-balanced map implementation (see "Data.Map").+-- structure performs especially well on binary operations like 'union' and+-- 'intersection'. Additionally, benchmarks show that it is also (much) faster+-- on insertions and deletions when compared to a generic size-balanced map+-- implementation (see "Data.Map"). -- --    * Chris Okasaki and Andy Gill,  \"/Fast Mergeable Integer Maps/\", --      Workshop on ML, September 1998, pages 77-86,@@ -43,18 +64,9 @@ --      Information Coded In Alphanumeric/\", Journal of the ACM, 15(4), --      October 1968, pages 514-534. ----- Operation comments contain the operation time complexity in--- the Big-O notation <http://en.wikipedia.org/wiki/Big_O_notation>.--- Many operations have a worst-case complexity of /O(min(n,W))/.--- This means that the operation can become linear in the number of--- elements with a maximum of /W/ -- the number of bits in an 'Int'--- (32 or 64). -----------------------------------------------------------------------------  module Data.IntMap.Lazy (-    -- * Strictness properties-    -- $strictness-     -- * Map type #if !defined(TESTING)     IntMap, Key          -- instance Eq,Show@@ -62,32 +74,29 @@     IntMap(..), Key          -- instance Eq,Show #endif -    -- * Operators-    , (!), (!?), (\\)--    -- * Query-    , IM.null-    , size-    , member-    , notMember-    , IM.lookup-    , findWithDefault-    , lookupLT-    , lookupGT-    , lookupLE-    , lookupGE-     -- * Construction     , empty     , singleton+    , fromSet -    -- ** Insertion+    -- ** From Unordered Lists+    , fromList+    , fromListWith+    , fromListWithKey++    -- ** From Ascending Lists+    , fromAscList+    , fromAscListWith+    , fromAscListWithKey+    , fromDistinctAscList++    -- * Insertion     , insert     , insertWith     , insertWithKey     , insertLookupWithKey -    -- ** Delete\/Update+    -- * Deletion\/Update     , delete     , adjust     , adjustWithKey@@ -97,6 +106,23 @@     , alter     , alterF +    -- * Query+    -- ** Lookup+    , IM.lookup+    , (!?)+    , (!)+    , findWithDefault+    , member+    , notMember+    , lookupLT+    , lookupGT+    , lookupLE+    , lookupGE++    -- ** Size+    , IM.null+    , size+     -- * Combine      -- ** Union@@ -108,6 +134,7 @@      -- ** Difference     , difference+    , (\\)     , differenceWith     , differenceWithKey @@ -149,21 +176,13 @@     , keys     , assocs     , keysSet-    , fromSet      -- ** Lists     , toList-    , fromList-    , fromListWith-    , fromListWithKey      -- ** Ordered lists     , toAscList     , toDescList-    , fromAscList-    , fromAscListWith-    , fromAscListWithKey-    , fromDistinctAscList      -- * Filter     , IM.filter@@ -204,22 +223,14 @@     , minViewWithKey     , maxViewWithKey +#ifdef __GLASGOW_HASKELL__     -- * Debugging     , showTree     , showTreeWith+#endif     ) where  import Data.IntMap.Internal as IM hiding (showTree, showTreeWith)+#ifdef __GLASGOW_HASKELL__ import Data.IntMap.Internal.DeprecatedDebug---- $strictness------ This module satisfies the following strictness property:------ * Key arguments are evaluated to WHNF------ Here are some examples that illustrate the property:------ > insertWith (\ new old -> old) undefined v m  ==  undefined--- > insertWith (\ new old -> old) k undefined m  ==  OK--- > delete undefined m  ==  undefined+#endif
Data/IntMap/Merge/Lazy.hs view
@@ -3,7 +3,7 @@ #if __GLASGOW_HASKELL__ {-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-} #endif-#if !defined(TESTING) && __GLASGOW_HASKELL__ >= 703+#if !defined(TESTING) && defined(__GLASGOW_HASKELL__) {-# LANGUAGE Safe #-} #endif #if __GLASGOW_HASKELL__ >= 708
Data/IntMap/Merge/Strict.hs view
@@ -3,7 +3,7 @@ #if __GLASGOW_HASKELL__ {-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-} #endif-#if !defined(TESTING) && __GLASGOW_HASKELL__ >= 703+#if !defined(TESTING) && defined(__GLASGOW_HASKELL__) {-# LANGUAGE Safe #-} #endif #if __GLASGOW_HASKELL__ >= 708
Data/IntMap/Strict.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-}-#if !defined(TESTING) && __GLASGOW_HASKELL__ >= 703+#if !defined(TESTING) && defined(__GLASGOW_HASKELL__) {-# LANGUAGE Trustworthy #-} #endif @@ -15,26 +15,63 @@ -- Maintainer  :  libraries@haskell.org -- Portability :  portable ----- An efficient implementation of maps from integer keys to values--- (dictionaries). ----- API of this module is strict in both the keys and the values.--- If you need value-lazy maps, use "Data.IntMap.Lazy" instead.--- The 'IntMap' type itself is shared between the lazy and strict modules,--- meaning that the same 'IntMap' value can be passed to functions in--- both modules (although that is rarely needed).+-- = Finite Int Maps (strict interface) ----- These modules are intended to be imported qualified, to avoid name--- clashes with Prelude functions, e.g.+-- The @'IntMap' v@ type represents a finite map (sometimes called a dictionary)+-- from key of type @Int@ to values of type @v@. ----- >  import Data.IntMap.Strict (IntMap)--- >  import qualified Data.IntMap.Strict as IntMap+-- Each function in this module is careful to force values before installing+-- them in a 'Map'. This is usually more efficient when laziness is not+-- necessary. When laziness /is/ required, use the functions in+-- "Data.IntMap.Lazy". --+-- In particular, the functions in this module obey the following law:+--+--  - If all values stored in all maps in the arguments are in WHNF, then all+--    values stored in all maps in the results will be in WHNF once those maps+--    are evaluated.+--+-- For a walkthrough of the most commonly used functions see the+-- <https://haskell-containers.readthedocs.io/en/latest/map.html maps introduction>.+--+-- This module is intended to be imported qualified, to avoid name clashes with+-- Prelude functions:+--+-- > import Data.IntMap.Strict (IntMap)+-- > import qualified Data.IntMap.Strict as IntMap+--+-- Note that the implementation is generally /left-biased/. Functions that take+-- two maps as arguments and combine them, such as `union` and `intersection`,+-- prefer the values in the first argument to those in the second.+--+--+-- == Detailed performance information+--+-- The amortized running time is given for each operation, with /n/ referring to+-- the number of entries in the map and /W/ referring to the number of bits in+-- an 'Int' (32 or 64).+--+-- Benchmarks comparing "Data.IntMap.Strict" with other dictionary+-- implementations can be found at https://github.com/haskell-perf/dictionaries.+--+--+-- == Warning+--+-- The 'IntMap' type is shared between the lazy and strict modules, meaning that+-- the same 'IntMap' value can be passed to functions in both modules. This+-- means that the 'Functor', 'Traversable' and 'Data' instances are the same as+-- for the "Data.IntMap.Lazy" module, so if they are used the resulting map may+-- contain suspended values (thunks).+--+--+-- == Implementation+-- -- The implementation is based on /big-endian patricia trees/.  This data--- structure performs especially well on binary operations like 'union'--- and 'intersection'.  However, my benchmarks show that it is also--- (much) faster on insertions and deletions when compared to a generic--- size-balanced map implementation (see "Data.Map").+-- structure performs especially well on binary operations like 'union' and+-- 'intersection'. Additionally, benchmarks show that it is also (much) faster+-- on insertions and deletions when compared to a generic size-balanced map+-- implementation (see "Data.Map"). -- --    * Chris Okasaki and Andy Gill,  \"/Fast Mergeable Integer Maps/\", --      Workshop on ML, September 1998, pages 77-86,@@ -44,24 +81,11 @@ --      Information Coded In Alphanumeric/\", Journal of the ACM, 15(4), --      October 1968, pages 514-534. ----- Operation comments contain the operation time complexity in--- the Big-O notation <http://en.wikipedia.org/wiki/Big_O_notation>.--- Many operations have a worst-case complexity of /O(min(n,W))/.--- This means that the operation can become linear in the number of--- elements with a maximum of /W/ -- the number of bits in an 'Int'--- (32 or 64).------ Be aware that the 'Functor', 'Traversable' and 'Data' instances--- are the same as for the "Data.IntMap.Lazy" module, so if they are used--- on strict maps, the resulting maps will be lazy. -----------------------------------------------------------------------------  -- See the notes at the beginning of Data.IntMap.Internal.  module Data.IntMap.Strict (-    -- * Strictness properties-    -- $strictness-     -- * Map type #if !defined(TESTING)     IntMap, Key          -- instance Eq,Show@@ -69,32 +93,29 @@     IntMap(..), Key          -- instance Eq,Show #endif -    -- * Operators-    , (!), (!?), (\\)--    -- * Query-    , null-    , size-    , member-    , notMember-    , lookup-    , findWithDefault-    , lookupLT-    , lookupGT-    , lookupLE-    , lookupGE-     -- * Construction     , empty     , singleton+    , fromSet -    -- ** Insertion+    -- ** From Unordered Lists+    , fromList+    , fromListWith+    , fromListWithKey++    -- ** From Ascending Lists+    , fromAscList+    , fromAscListWith+    , fromAscListWithKey+    , fromDistinctAscList++    -- * Insertion     , insert     , insertWith     , insertWithKey     , insertLookupWithKey -    -- ** Delete\/Update+    -- * Deletion\/Update     , delete     , adjust     , adjustWithKey@@ -104,6 +125,23 @@     , alter     , alterF +    -- * Query+    -- ** Lookup+    , lookup+    , (!?)+    , (!)+    , findWithDefault+    , member+    , notMember+    , lookupLT+    , lookupGT+    , lookupLE+    , lookupGE++    -- ** Size+    , null+    , size+     -- * Combine      -- ** Union@@ -115,6 +153,7 @@      -- ** Difference     , difference+    , (\\)     , differenceWith     , differenceWithKey @@ -156,21 +195,13 @@     , keys     , assocs     , keysSet-    , fromSet      -- ** Lists     , toList-    , fromList-    , fromListWith-    , fromListWithKey -    -- ** Ordered lists+-- ** Ordered lists     , toAscList     , toDescList-    , fromAscList-    , fromAscListWith-    , fromAscListWithKey-    , fromDistinctAscList      -- * Filter     , filter@@ -211,9 +242,11 @@     , minViewWithKey     , maxViewWithKey +#ifdef __GLASGOW_HASKELL__     -- * Debugging     , showTree     , showTreeWith+#endif     ) where  import Prelude hiding (lookup,map,filter,foldr,foldl,null)@@ -300,33 +333,18 @@   , unions   , withoutKeys   )+#ifdef __GLASGOW_HASKELL__ import Data.IntMap.Internal.DeprecatedDebug (showTree, showTreeWith)+#endif import qualified Data.IntSet.Internal as IntSet import Utils.Containers.Internal.BitUtil-import Utils.Containers.Internal.StrictFold import Utils.Containers.Internal.StrictPair #if !MIN_VERSION_base(4,8,0) import Data.Functor((<$>)) #endif import Control.Applicative (Applicative (..), liftA2)---- $strictness------ This module satisfies the following strictness properties:------ 1. Key arguments are evaluated to WHNF;------ 2. Keys and values are evaluated to WHNF before they are stored in---    the map.------ Here's an example illustrating the first property:------ > delete undefined m  ==  undefined------ Here are some examples that illustrate the second property:------ > map (\ v -> undefined) m  ==  undefined      -- m is not empty--- > mapKeys (\ k -> undefined) m  ==  undefined  -- m is not empty+import qualified Data.Foldable as Foldable+import Data.Foldable (Foldable())  {--------------------------------------------------------------------   Query@@ -413,7 +431,7 @@ -- > insertWithKey f 7 "xxx" (fromList [(5,"a"), (3,"b")]) == fromList [(3, "b"), (5, "a"), (7, "xxx")] -- > insertWithKey f 5 "xxx" empty                         == singleton 5 "xxx" ----- If the key exists in the map, this function is lazy in @x@ but strict+-- If the key exists in the map, this function is lazy in @value@ but strict -- in the result of @f@.  insertWithKey :: (Key -> a -> a -> a) -> Key -> a -> IntMap a -> IntMap a@@ -625,9 +643,9 @@ -- > unionsWith (++) [(fromList [(5, "a"), (3, "b")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "A3"), (3, "B3")])] -- >     == fromList [(3, "bB3"), (5, "aAA3"), (7, "C")] -unionsWith :: (a->a->a) -> [IntMap a] -> IntMap a+unionsWith :: Foldable f => (a->a->a) -> f (IntMap a) -> IntMap a unionsWith f ts-  = foldlStrict (unionWith f) empty ts+  = Foldable.foldl' (unionWith f) empty ts  -- | /O(n+m)/. The union with a combining function. --@@ -1036,7 +1054,7 @@  fromList :: [(Key,a)] -> IntMap a fromList xs-  = foldlStrict ins empty xs+  = Foldable.foldl' ins empty xs   where     ins t (k,x)  = insert k x t @@ -1056,7 +1074,7 @@  fromListWithKey :: (Key -> a -> a -> a) -> [(Key,a)] -> IntMap a fromListWithKey f xs-  = foldlStrict ins empty xs+  = Foldable.foldl' ins empty xs   where     ins t (k,x) = insertWithKey f k x t 
Data/IntSet.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE CPP #-}-#if !defined(TESTING) && __GLASGOW_HASKELL__ >= 703+#if !defined(TESTING) && defined(__GLASGOW_HASKELL__) {-# LANGUAGE Safe #-} #endif @@ -14,14 +14,31 @@ -- Maintainer  :  libraries@haskell.org -- Portability :  portable ----- An efficient implementation of integer sets. --+-- = Finite Int Sets+--+-- The @'IntSet'@ type represents a set of elements of type @Int@.+--+-- For a walkthrough of the most commonly used functions see their+-- <https://haskell-containers.readthedocs.io/en/latest/set.html sets introduction>.+-- -- These modules are intended to be imported qualified, to avoid name -- clashes with Prelude functions, e.g. -- -- >  import Data.IntSet (IntSet) -- >  import qualified Data.IntSet as IntSet --+--+-- == Performance information+--+-- Many operations have a worst-case complexity of /O(min(n,W))/.+-- This means that the operation can become linear in the number of+-- elements with a maximum of /W/ -- the number of bits in an 'Int'+-- (32 or 64).+--+--+-- == Implementation+-- -- The implementation is based on /big-endian patricia trees/.  This data -- structure performs especially well on binary operations like 'union' -- and 'intersection'.  However, my benchmarks show that it is also@@ -38,14 +55,10 @@ -- -- Additionally, this implementation places bitmaps in the leaves of the tree. -- Their size is the natural size of a machine word (32 or 64 bits) and greatly--- reduce memory footprint and execution times for dense sets, e.g. sets where--- it is likely that many values lie close to each other. The asymptotics are--- not affected by this optimization.+-- reduces the memory footprint and execution times for dense sets, e.g. sets+-- where it is likely that many values lie close to each other. The asymptotics+-- are not affected by this optimization. ----- Many operations have a worst-case complexity of /O(min(n,W))/.--- This means that the operation can become linear in the number of--- elements with a maximum of /W/ -- the number of bits in an 'Int'--- (32 or 64). -----------------------------------------------------------------------------  module Data.IntSet (@@ -60,32 +73,37 @@ #endif             , Key -            -- * Operators-            , (\\)+            -- * Construction+            , empty+            , singleton+            , fromList+            , fromAscList+            , fromDistinctAscList +            -- * Insertion+            , insert++            -- * Deletion+            , delete+             -- * Query-            , IS.null-            , size             , member             , notMember             , lookupLT             , lookupGT             , lookupLE             , lookupGE+            , IS.null+            , size             , isSubsetOf             , isProperSubsetOf             , disjoint -            -- * Construction-            , empty-            , singleton-            , insert-            , delete-             -- * Combine             , union             , unions             , difference+            , (\\)             , intersection              -- * Filter@@ -122,13 +140,8 @@             -- ** List             , elems             , toList-            , fromList--            -- ** Ordered list             , toAscList             , toDescList-            , fromAscList-            , fromDistinctAscList              -- * Debugging             , showTree
Data/IntSet/Internal.hs view
@@ -3,7 +3,7 @@ #if __GLASGOW_HASKELL__ {-# LANGUAGE MagicHash, DeriveDataTypeable, StandaloneDeriving #-} #endif-#if !defined(TESTING) && __GLASGOW_HASKELL__ >= 703+#if !defined(TESTING) && defined(__GLASGOW_HASKELL__) {-# LANGUAGE Trustworthy #-} #endif #if __GLASGOW_HASKELL__ >= 708@@ -201,7 +201,6 @@ import Prelude hiding (filter, foldr, foldl, null, map)  import Utils.Containers.Internal.BitUtil-import Utils.Containers.Internal.StrictFold import Utils.Containers.Internal.StrictPair  #if __GLASGOW_HASKELL__@@ -217,6 +216,8 @@ import GHC.Prim (indexInt8OffAddr#) #endif +import qualified Data.Foldable as Foldable+import Data.Foldable (Foldable())  infixl 9 \\{-This comment teaches CPP correct behaviour -} @@ -499,9 +500,9 @@   Union --------------------------------------------------------------------} -- | The union of a list of sets.-unions :: [IntSet] -> IntSet+unions :: Foldable f => f IntSet -> IntSet unions xs-  = foldlStrict union empty xs+  = Foldable.foldl' union empty xs   -- | /O(n+m)/. The union of two sets.@@ -642,7 +643,7 @@ subsetCmp Nil _   = LT  -- | /O(n+m)/. Is this a subset?--- @(s1 `isSubsetOf` s2)@ tells whether @s1@ is a subset of @s2@.+-- @(s1 \`isSubsetOf\` s2)@ tells whether @s1@ is a subset of @s2@.  isSubsetOf :: IntSet -> IntSet -> Bool isSubsetOf t1@(Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)@@ -1044,7 +1045,7 @@ -- | /O(n*min(n,W))/. Create a set from a list of integers. fromList :: [Key] -> IntSet fromList xs-  = foldlStrict ins empty xs+  = Foldable.foldl' ins empty xs   where     ins t x  = insert x t 
Data/Map.hs view
@@ -1,8 +1,15 @@ {-# LANGUAGE CPP #-}-#if !defined(TESTING) && __GLASGOW_HASKELL__ >= 703+#if !defined(TESTING) && defined(__GLASGOW_HASKELL__) {-# LANGUAGE Safe #-} #endif +#ifdef __GLASGOW_HASKELL__+{-# LANGUAGE DataKinds, FlexibleContexts #-}+#endif+#if __GLASGOW_HASKELL__ >= 800+{-# LANGUAGE MonoLocalBinds #-}+#endif+ #include "containers.h"  -----------------------------------------------------------------------------@@ -60,72 +67,48 @@  module Data.Map     ( module Data.Map.Lazy+#ifdef __GLASGOW_HASKELL__     , insertWith'     , insertWithKey'     , insertLookupWithKey'     , fold     , foldWithKey+#endif     ) where -import Prelude hiding (foldr) import Data.Map.Lazy-import qualified Data.Map.Strict as Strict --- | /O(log n)/. Same as 'insertWith', but the value being inserted to the map is--- evaluated to WHNF beforehand.------ For example, to update a counter:------ > insertWith' (+) k 1 m----{-# DEPRECATED insertWith' "As of version 0.5, replaced by 'Data.Map.Strict.insertWith'." #-}-insertWith' :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a-insertWith' = Strict.insertWith-#if __GLASGOW_HASKELL__-{-# INLINABLE insertWith' #-}-#else-{-# INLINE insertWith' #-}-#endif+#ifdef __GLASGOW_HASKELL__+import Utils.Containers.Internal.TypeError --- | /O(log n)/. Same as 'insertWithKey', but the value being inserted to the map is--- evaluated to WHNF beforehand.-{-# DEPRECATED insertWithKey' "As of version 0.5, replaced by 'Data.Map.Strict.insertWithKey'." #-}-insertWithKey' :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a--- We do not reuse Data.Map.Strict.insertWithKey, because it is stricter -- it--- forces evaluation of the given value.-insertWithKey' = Strict.insertWithKey-#if __GLASGOW_HASKELL__-{-# INLINABLE insertWithKey' #-}-#else-{-# INLINE insertWithKey' #-}-#endif+-- | This function is being removed and is no longer usable.+-- Use 'Data.Map.Strict.insertWith'.+insertWith' :: Whoops "Data.Map.insertWith' is gone. Use Data.Map.Strict.insertWith."+            => (a -> a -> a) -> k -> a -> Map k a -> Map k a+insertWith' _ _ _ _ = undefined --- | /O(log n)/. Same as 'insertLookupWithKey', but the value being inserted to--- the map is evaluated to WHNF beforehand.-{-# DEPRECATED insertLookupWithKey' "As of version 0.5, replaced by 'Data.Map.Strict.insertLookupWithKey'." #-}-insertLookupWithKey' :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a+-- | This function is being removed and is no longer usable.+-- Use 'Data.Map.Strict.insertWithKey'.+insertWithKey' :: Whoops "Data.Map.insertWithKey' is gone. Use Data.Map.Strict.insertWithKey."+               => (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a+insertWithKey' _ _ _ _ = undefined++-- | This function is being removed and is no longer usable.+-- Use 'Data.Map.Strict.insertLookupWithKey'.+insertLookupWithKey' :: Whoops "Data.Map.insertLookupWithKey' is gone. Use Data.Map.Strict.insertLookupWithKey."+                     => (k -> a -> a -> a) -> k -> a -> Map k a                      -> (Maybe a, Map k a)--- We do not reuse Data.Map.Strict.insertLookupWithKey, because it is stricter -- it--- forces evaluation of the given value.-insertLookupWithKey' = Strict.insertLookupWithKey-#if __GLASGOW_HASKELL__-{-# INLINABLE insertLookupWithKey' #-}-#else-{-# INLINE insertLookupWithKey' #-}-#endif+insertLookupWithKey' _ _ _ _ = undefined --- | /O(n)/. Fold the values in the map using the given right-associative--- binary operator. This function is an equivalent of 'foldr' and is present--- for compatibility only.-{-# DEPRECATED fold "As of version 0.5, replaced by 'foldr'." #-}-fold :: (a -> b -> b) -> b -> Map k a -> b-fold = foldr-{-# INLINE fold #-}+-- | This function is being removed and is no longer usable.+-- Use 'foldr'.+fold :: Whoops "Data.Map.fold is gone. Use foldr."+     => (a -> b -> b) -> b -> Map k a -> b+fold _ _ _ = undefined --- | /O(n)/. Fold the keys and values in the map using the given right-associative--- binary operator. This function is an equivalent of 'foldrWithKey' and is present--- for compatibility only.-{-# DEPRECATED foldWithKey "As of version 0.4, replaced by 'foldrWithKey'." #-}-foldWithKey :: (k -> a -> b -> b) -> b -> Map k a -> b-foldWithKey = foldrWithKey-{-# INLINE foldWithKey #-}+-- | This function is being removed and is no longer usable.+-- Use 'foldrWithKey'.+foldWithKey :: Whoops "Data.Map.foldWithKey is gone. Use foldrWithKey."+            => (k -> a -> b -> b) -> b -> Map k a -> b+foldWithKey _ _ _ = undefined+#endif
Data/Map/Internal.hs view
@@ -4,7 +4,7 @@ #if __GLASGOW_HASKELL__ {-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-} #endif-#if __GLASGOW_HASKELL__ >= 703+#if defined(__GLASGOW_HASKELL__) {-# LANGUAGE Trustworthy #-} #endif #if __GLASGOW_HASKELL__ >= 708@@ -378,13 +378,13 @@ import Control.DeepSeq (NFData(rnf)) import Data.Bits (shiftL, shiftR) import qualified Data.Foldable as Foldable+import Data.Foldable (Foldable()) import Data.Typeable import Prelude hiding (lookup, map, filter, foldr, foldl, null, splitAt, take, drop)  import qualified Data.Set.Internal as Set import Data.Set.Internal (Set) import Utils.Containers.Internal.PtrEquality (ptrEq)-import Utils.Containers.Internal.StrictFold import Utils.Containers.Internal.StrictPair import Utils.Containers.Internal.StrictMaybe import Utils.Containers.Internal.BitQueue@@ -1782,9 +1782,9 @@ -- > unions [(fromList [(5, "A3"), (3, "B3")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "a"), (3, "b")])] -- >     == fromList [(3, "B3"), (5, "A3"), (7, "C")] -unions :: Ord k => [Map k a] -> Map k a+unions :: (Foldable f, Ord k) => f (Map k a) -> Map k a unions ts-  = foldlStrict union empty ts+  = Foldable.foldl' union empty ts #if __GLASGOW_HASKELL__ {-# INLINABLE unions #-} #endif@@ -1795,9 +1795,9 @@ -- > unionsWith (++) [(fromList [(5, "a"), (3, "b")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "A3"), (3, "B3")])] -- >     == fromList [(3, "bB3"), (5, "aAA3"), (7, "C")] -unionsWith :: Ord k => (a->a->a) -> [Map k a] -> Map k a+unionsWith :: (Foldable f, Ord k) => (a->a->a) -> f (Map k a) -> Map k a unionsWith f ts-  = foldlStrict (unionWith f) empty ts+  = Foldable.foldl' (unionWith f) empty ts #if __GLASGOW_HASKELL__ {-# INLINABLE unionsWith #-} #endif@@ -1899,8 +1899,8 @@ -- | /O(m*log(n\/m + 1)), m <= n/. Remove all keys in a 'Set' from a 'Map'. -- -- @--- m `'withoutKeys'` s = 'filterWithKey' (\k _ -> k `'Set.notMember'` s) m--- m `'withoutKeys'` s = m `'difference'` 'fromSet' (const ()) s+-- m \`withoutKeys\` s = 'filterWithKey' (\k _ -> k ``Set.notMember`` s) m+-- m \`withoutKeys\` s = m ``difference`` 'fromSet' (const ()) s -- @ -- -- @since 0.5.8@@ -1981,8 +1981,8 @@ -- found in a 'Set'. -- -- @--- m `'restrictKeys'` s = 'filterWithKey' (\k _ -> k `'Set.member'` s) m--- m `'restrictKeys'` s = m `'intersect' 'fromSet' (const ()) s+-- m \`restrictKeys\` s = 'filterWithKey' (\k _ -> k ``Set.member`` s) m+-- m \`restrictKeys\` s = m ``intersect`` 'fromSet' (const ()) s -- @ -- -- @since 0.5.8@@ -3348,7 +3348,7 @@     not_ordered kx ((ky,_) : _) = kx >= ky     {-# INLINE not_ordered #-} -    fromList' t0 xs = foldlStrict ins t0 xs+    fromList' t0 xs = Foldable.foldl' ins t0 xs       where ins t (k,x) = insert k x t      go !_ t [] = t@@ -3397,7 +3397,7 @@  fromListWithKey :: Ord k => (k -> a -> a -> a) -> [(k,a)] -> Map k a fromListWithKey f xs-  = foldlStrict ins empty xs+  = Foldable.foldl' ins empty xs   where     ins t (k,x) = insertWithKey f k x t #if __GLASGOW_HASKELL__@@ -4142,13 +4142,10 @@           go (Bin 1 _ v _ _) = f v           go (Bin _ _ v l r) = go l `mappend` (f v `mappend` go r)   {-# INLINE foldMap #-}--#if MIN_VERSION_base(4,6,0)   foldl' = foldl'   {-# INLINE foldl' #-}   foldr' = foldr'   {-# INLINE foldr' #-}-#endif #if MIN_VERSION_base(4,8,0)   length = size   {-# INLINE length #-}
Data/Map/Internal/DeprecatedShowTree.hs view
@@ -1,56 +1,29 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP, FlexibleContexts, DataKinds #-}+#if __GLASGOW_HASKELL__ >= 800+{-# LANGUAGE MonoLocalBinds #-}+#endif+#if __GLASGOW_HASKELL__ < 710+-- Why do we need this? Guess it doesn't matter; this is all+-- going away soon.+{-# LANGUAGE Trustworthy #-}+#endif  #include "containers.h" --- | This module simply holds deprecated copies of functions from+-- | This module simply holds disabled copies of functions from -- Data.Map.Internal.Debug. module Data.Map.Internal.DeprecatedShowTree where -import qualified Data.Map.Internal.Debug as Debug import Data.Map.Internal (Map)---- | /O(n)/. Show the tree that implements the map. The tree is shown--- in a compressed, hanging format. See 'showTreeWith'.-{-# DEPRECATED showTree "'showTree' is now in \"Data.Map.Internal.Debug\"" #-}-showTree :: (Show k,Show a) => Map k a -> String-showTree = Debug.showTree--{- | /O(n)/. The expression (@'showTreeWith' showelem hang wide map@) shows- the tree that implements the map. Elements are shown using the @showElem@ function. If @hang@ is- 'True', a /hanging/ tree is shown otherwise a rotated tree is shown. If- @wide@ is 'True', an extra wide version is shown.+import Utils.Containers.Internal.TypeError ->  Map> let t = fromDistinctAscList [(x,()) | x <- [1..5]]->  Map> putStrLn $ showTreeWith (\k x -> show (k,x)) True False t->  (4,())->  +--(2,())->  |  +--(1,())->  |  +--(3,())->  +--(5,())->->  Map> putStrLn $ showTreeWith (\k x -> show (k,x)) True True t->  (4,())->  |->  +--(2,())->  |  |->  |  +--(1,())->  |  |->  |  +--(3,())->  |->  +--(5,())->->  Map> putStrLn $ showTreeWith (\k x -> show (k,x)) False True t->  +--(5,())->  |->  (4,())->  |->  |  +--(3,())->  |  |->  +--(2,())->     |->     +--(1,())+-- | This function has moved to 'Data.Map.Internal.Debug.showTree'.+showTree :: Whoops "showTree has moved to Data.Map.Internal.Debug.showTree."+         => Map k a -> String+showTree _ = undefined --}-{-# DEPRECATED showTreeWith "'showTreeWith' is now in \"Data.Map.Internal.Debug\"" #-}-showTreeWith :: (k -> a -> String) -> Bool -> Bool -> Map k a -> String-showTreeWith = Debug.showTreeWith+-- | This function has moved to 'Data.Map.Internal.Debug.showTreeWith'.+showTreeWith ::+      Whoops "showTreeWith has moved to Data.Map.Internal.Debug.showTreeWith."+   => (k -> a -> String) -> Bool -> Bool -> Map k a -> String+showTreeWith _ _ _ _ = undefined
Data/Map/Lazy.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE CPP #-}-#if __GLASGOW_HASKELL__ >= 703+#if defined(__GLASGOW_HASKELL__) {-# LANGUAGE Safe #-} #endif @@ -88,32 +88,35 @@     -- * Map type     Map              -- instance Eq,Show,Read -    -- * Operators-    , (!), (!?), (\\)--    -- * Query-    , null-    , size-    , member-    , notMember-    , lookup-    , findWithDefault-    , lookupLT-    , lookupGT-    , lookupLE-    , lookupGE-     -- * Construction     , empty     , singleton+    , fromSet -    -- ** Insertion+    -- ** From Unordered Lists+    , fromList+    , fromListWith+    , fromListWithKey++    -- ** From Ascending Lists+    , fromAscList+    , fromAscListWith+    , fromAscListWithKey+    , fromDistinctAscList++    -- ** From Descending Lists+    , fromDescList+    , fromDescListWith+    , fromDescListWithKey+    , fromDistinctDescList++    -- * Insertion     , insert     , insertWith     , insertWithKey     , insertLookupWithKey -    -- ** Delete\/Update+    -- * Deletion\/Update     , delete     , adjust     , adjustWithKey@@ -123,6 +126,23 @@     , alter     , alterF +    -- * Query+    -- ** Lookup+    , lookup+    , (!?)+    , (!)+    , findWithDefault+    , member+    , notMember+    , lookupLT+    , lookupGT+    , lookupLE+    , lookupGE++    -- ** Size+    , null+    , size+     -- * Combine      -- ** Union@@ -134,6 +154,7 @@      -- ** Difference     , difference+    , (\\)     , differenceWith     , differenceWithKey @@ -180,25 +201,13 @@     , keys     , assocs     , keysSet-    , fromSet      -- ** Lists     , toList-    , fromList-    , fromListWith-    , fromListWithKey      -- ** Ordered lists     , toAscList     , toDescList-    , fromAscList-    , fromAscListWith-    , fromAscListWithKey-    , fromDistinctAscList-    , fromDescList-    , fromDescListWith-    , fromDescListWithKey-    , fromDistinctDescList      -- * Filter     , filter@@ -253,8 +262,10 @@     , maxViewWithKey      -- * Debugging+#ifdef __GLASGOW_HASKELL__     , showTree     , showTreeWith+#endif     , valid     ) where 
− Data/Map/Lazy/Merge.hs
@@ -1,39 +0,0 @@-{-# LANGUAGE CPP #-}-#if !defined(TESTING) && __GLASGOW_HASKELL__ >= 703-{-# LANGUAGE Safe #-}-#endif--#include "containers.h"--{-# OPTIONS_HADDOCK hide #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Map.Lazy.Merge--- Copyright   :  (c) David Feuer 2016--- License     :  BSD-style--- Maintainer  :  libraries@haskell.org--- Portability :  portable------ This module defines an API for writing functions that merge two--- maps. The key functions are 'merge' and 'mergeA'.--- Each of these can be used with several different "merge tactics".------ The 'merge' and 'mergeA' functions are shared by--- the lazy and strict modules. Only the choice of merge tactics--- determines strictness. If you use 'Data.Map.Strict.Merge.mapMissing'--- from "Data.Map.Strict.Merge" then the results will be forced before--- they are inserted. If you use 'Data.Map.Lazy.Merge.mapMissing' from--- this module then they will not.------ == Efficiency note------ The 'Category', 'Applicative', and 'Monad' instances for 'WhenMissing'--- tactics are included because they are valid. However, they are--- inefficient in many cases and should usually be avoided. The instances--- for 'WhenMatched' tactics should not pose any major efficiency problems.--module Data.Map.Lazy.Merge {-# DEPRECATED "Use \"Data.Map.Merge.Lazy\"." #-}-    ( module Data.Map.Merge.Lazy ) where--import Data.Map.Merge.Lazy
Data/Map/Merge/Lazy.hs view
@@ -3,7 +3,7 @@ #if __GLASGOW_HASKELL__ {-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-} #endif-#if !defined(TESTING) && __GLASGOW_HASKELL__ >= 703+#if !defined(TESTING) && defined(__GLASGOW_HASKELL__) {-# LANGUAGE Safe #-} #endif #if __GLASGOW_HASKELL__ >= 708
Data/Map/Merge/Strict.hs view
@@ -3,7 +3,7 @@ #if __GLASGOW_HASKELL__ {-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-} #endif-#if !defined(TESTING) && __GLASGOW_HASKELL__ >= 703+#if !defined(TESTING) && defined(__GLASGOW_HASKELL__) {-# LANGUAGE Safe #-} #endif #if __GLASGOW_HASKELL__ >= 708
Data/Map/Strict.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-}-#if __GLASGOW_HASKELL__ >= 703+#if defined(__GLASGOW_HASKELL__) {-# LANGUAGE Safe #-} #endif @@ -71,8 +71,8 @@ -- The 'Map' type is shared between the lazy and strict modules, meaning that -- the same 'Map' value can be passed to functions in both modules. This means -- that the 'Functor', 'Traversable' and 'Data' instances are the same as for--- the "Data.Map.Lazy" module, so if they are used on strict maps, the resulting--- maps may contain suspended values (thunks).+-- the "Data.Map.Lazy" module, so if they are used the resulting maps may contain+-- suspended values (thunks). -- -- -- == Implementation@@ -104,32 +104,35 @@     -- * Map type     Map              -- instance Eq,Show,Read -    -- * Operators-    , (!), (!?), (\\)--    -- * Query-    , null-    , size-    , member-    , notMember-    , lookup-    , findWithDefault-    , lookupLT-    , lookupGT-    , lookupLE-    , lookupGE-     -- * Construction     , empty     , singleton+    , fromSet -    -- ** Insertion+    -- ** From Unordered Lists+    , fromList+    , fromListWith+    , fromListWithKey++    -- ** From Ascending Lists+    , fromAscList+    , fromAscListWith+    , fromAscListWithKey+    , fromDistinctAscList++    -- ** From Descending Lists+    , fromDescList+    , fromDescListWith+    , fromDescListWithKey+    , fromDistinctDescList++    -- * Insertion     , insert     , insertWith     , insertWithKey     , insertLookupWithKey -    -- ** Delete\/Update+    -- * Deletion\/Update     , delete     , adjust     , adjustWithKey@@ -139,6 +142,23 @@     , alter     , alterF +    -- * Query+    -- ** Lookup+    , lookup+    , (!?)+    , (!)+    , findWithDefault+    , member+    , notMember+    , lookupLT+    , lookupGT+    , lookupLE+    , lookupGE++    -- ** Size+    , null+    , size+     -- * Combine      -- ** Union@@ -150,6 +170,7 @@      -- ** Difference     , difference+    , (\\)     , differenceWith     , differenceWithKey @@ -196,25 +217,13 @@     , keys     , assocs     , keysSet-    , fromSet      -- ** Lists     , toList-    , fromList-    , fromListWith-    , fromListWithKey      -- ** Ordered lists     , toAscList     , toDescList-    , fromAscList-    , fromAscListWith-    , fromAscListWithKey-    , fromDistinctAscList-    , fromDescList-    , fromDescListWith-    , fromDescListWithKey-    , fromDistinctDescList      -- * Filter     , filter@@ -270,8 +279,10 @@     , maxViewWithKey      -- * Debugging+#ifdef __GLASGOW_HASKELL__     , showTree     , showTreeWith+#endif     , valid     ) where 
Data/Map/Strict/Internal.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-}-#if __GLASGOW_HASKELL__ >= 703+#if defined(__GLASGOW_HASKELL__) {-# LANGUAGE Trustworthy #-} #endif {-# OPTIONS_HADDOCK not-home #-}@@ -292,8 +292,10 @@     , maxViewWithKey      -- * Debugging+#if defined(__GLASGOW_HASKELL__)     , showTree     , showTreeWith+#endif     , valid     ) where @@ -397,7 +399,9 @@   , unions   , withoutKeys ) +#if defined(__GLASGOW_HASKELL__) import Data.Map.Internal.DeprecatedShowTree (showTree, showTreeWith)+#endif import Data.Map.Internal.Debug (valid)  import Control.Applicative (Const (..), liftA3)@@ -406,7 +410,6 @@ #endif import qualified Data.Set.Internal as Set import qualified Data.Map.Internal as L-import Utils.Containers.Internal.StrictFold import Utils.Containers.Internal.StrictPair  import Data.Bits (shiftL, shiftR)@@ -418,6 +421,8 @@ import Data.Functor.Identity (Identity (..)) #endif +import qualified Data.Foldable as Foldable+import Data.Foldable (Foldable())  -- $strictness --@@ -951,9 +956,9 @@ -- > unionsWith (++) [(fromList [(5, "a"), (3, "b")]), (fromList [(5, "A"), (7, "C")]), (fromList [(5, "A3"), (3, "B3")])] -- >     == fromList [(3, "bB3"), (5, "aAA3"), (7, "C")] -unionsWith :: Ord k => (a->a->a) -> [Map k a] -> Map k a+unionsWith :: (Foldable f, Ord k) => (a->a->a) -> f (Map k a) -> Map k a unionsWith f ts-  = foldlStrict (unionWith f) empty ts+  = Foldable.foldl' (unionWith f) empty ts #if __GLASGOW_HASKELL__ {-# INLINABLE unionsWith #-} #endif@@ -1374,7 +1379,7 @@ #endif  -- | /O(n)/.--- @'traverseWithKey' f m == 'fromList' <$> 'traverse' (\(k, v) -> (\v' -> v' `seq` (k,v')) <$> f k v) ('toList' m)@+-- @'traverseWithKey' f m == 'fromList' <$> 'traverse' (\(k, v) -> (\v' -> v' \`seq\` (k,v')) <$> f k v) ('toList' m)@ -- That is, it behaves much like a regular 'traverse' except that the traversing -- function also has access to the key associated with a value and the values are -- forced before they are installed in the result map.@@ -1487,7 +1492,7 @@     not_ordered kx ((ky,_) : _) = kx >= ky     {-# INLINE not_ordered #-} -    fromList' t0 xs = foldlStrict ins t0 xs+    fromList' t0 xs = Foldable.foldl' ins t0 xs       where ins t (k,x) = insert k x t      go !_ t [] = t@@ -1536,7 +1541,7 @@  fromListWithKey :: Ord k => (k -> a -> a -> a) -> [(k,a)] -> Map k a fromListWithKey f xs-  = foldlStrict ins empty xs+  = Foldable.foldl' ins empty xs   where     ins t (k,x) = insertWithKey f k x t #if __GLASGOW_HASKELL__
− Data/Map/Strict/Merge.hs
@@ -1,39 +0,0 @@-{-# LANGUAGE CPP #-}-#if !defined(TESTING) && __GLASGOW_HASKELL__ >= 703-{-# LANGUAGE Safe #-}-#endif--#include "containers.h"--{-# OPTIONS_HADDOCK hide #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Map.Strict.Merge--- Copyright   :  (c) David Feuer 2016--- License     :  BSD-style--- Maintainer  :  libraries@haskell.org--- Portability :  portable------ This module defines an API for writing functions that merge two--- maps. The key functions are 'merge' and 'mergeA'.--- Each of these can be used with several different "merge tactics".------ The 'merge' and 'mergeA' functions are shared by--- the lazy and strict modules. Only the choice of merge tactics--- determines strictness. If you use 'Data.Map.Strict.Merge.mapMissing'--- from this module then the results will be forced before they are--- inserted. If you use 'Data.Map.Lazy.Merge.mapMissing' from--- "Data.Map.Lazy.Merge" then they will not.------ == Efficiency note------ The 'Category', 'Applicative', and 'Monad' instances for 'WhenMissing'--- tactics are included because they are valid. However, they are--- inefficient in many cases and should usually be avoided. The instances--- for 'WhenMatched' tactics should not pose any major efficiency problems.--module Data.Map.Strict.Merge {-# DEPRECATED "Use \"Data.Map.Merge.Strict\"." #-}-  ( module Data.Map.Merge.Strict ) where--import Data.Map.Merge.Strict
Data/Sequence.hs view
@@ -65,7 +65,7 @@ -- --     but -----     @ (1 :<| undefined) `index` 0 = undefined @+--     @ (1 :<| undefined) ``index`` 0 = undefined @ -- -- Sequences may also be compared to immutable -- [arrays](https://hackage.haskell.org/package/array)
Data/Sequence/Internal.hs view
@@ -3,17 +3,13 @@ {-# LANGUAGE BangPatterns #-} #if __GLASGOW_HASKELL__ {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-}-#endif-#if __GLASGOW_HASKELL__ >= 703 {-# LANGUAGE Trustworthy #-} #endif-#if __GLASGOW_HASKELL__ >= 702-{-# LANGUAGE DeriveGeneric #-}-#endif #ifdef DEFINE_PATTERN_SYNONYMS {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-}@@ -214,11 +210,7 @@ import Data.Monoid (Monoid(..)) import Data.Functor (Functor(..)) import Utils.Containers.Internal.State (State(..), execState)-#if MIN_VERSION_base(4,6,0) import Data.Foldable (Foldable(foldl, foldl1, foldr, foldr1, foldMap, foldl', foldr'), toList)-#else-import Data.Foldable (Foldable(foldl, foldl1, foldr, foldr1, foldMap), foldl', toList)-#endif  #if MIN_VERSION_base(4,9,0) import qualified Data.Semigroup as Semigroup@@ -235,10 +227,8 @@ import Data.Data import Data.String (IsString(..)) #endif-#if __GLASGOW_HASKELL__ >= 706+#if __GLASGOW_HASKELL__ import GHC.Generics (Generic, Generic1)-#elif __GLASGOW_HASKELL__ >= 702-import GHC.Generics (Generic) #endif  -- Array stuff, with GHC.Arr on GHC@@ -248,6 +238,7 @@ import qualified GHC.Arr #endif +import Utils.Containers.Internal.Coercions ((.#), (.^#)) -- Coercion on GHC 7.8+ #if __GLASGOW_HASKELL__ >= 708 import Data.Coerce@@ -265,9 +256,7 @@ #endif  import Utils.Containers.Internal.StrictPair (StrictPair (..), toPair)-#if MIN_VERSION_base(4,4,0) import Control.Monad.Zip (MonadZip (..))-#endif import Control.Monad.Fix (MonadFix (..), fix)  default ()@@ -385,20 +374,26 @@  #-} #endif +getSeq :: Seq a -> FingerTree (Elem a)+getSeq (Seq xs) = xs+ instance Foldable Seq where-    foldMap f (Seq xs) = foldMap (foldMap f) xs-#if __GLASGOW_HASKELL__ >= 708-    foldr f z (Seq xs) = foldr (coerce f) z xs-    foldr' f z (Seq xs) = foldr' (coerce f) z xs-#else-    foldr f z (Seq xs) = foldr (flip (foldr f)) z xs-#if MIN_VERSION_base(4,6,0)-    foldr' f z (Seq xs) = foldr' (flip (foldr' f)) z xs-#endif+    foldMap f = foldMap (f .# getElem) .# getSeq+    foldr f z = foldr (f .# getElem) z .# getSeq+    foldl f z = foldl (f .^# getElem) z .# getSeq++#if __GLASGOW_HASKELL__+    {-# INLINABLE foldMap #-}+    {-# INLINABLE foldr #-}+    {-# INLINABLE foldl #-} #endif-    foldl f z (Seq xs) = foldl (foldl f) z xs-#if MIN_VERSION_base(4,6,0)-    foldl' f z (Seq xs) = foldl' (foldl' f) z xs++    foldr' f z = foldr' (f .# getElem) z .# getSeq+    foldl' f z = foldl' (f .^# getElem) z .# getSeq++#if __GLASGOW_HASKELL__+    {-# INLINABLE foldr' #-}+    {-# INLINABLE foldl' #-} #endif      foldr1 f (Seq xs) = getElem (foldr1 f' xs)@@ -414,29 +409,81 @@     {-# 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 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) =-  liftA3 (\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+#if __GLASGOW_HASKELL__+    {-# INLINABLE traverse #-} #endif+    traverse _ (Seq EmptyT) = pure (Seq EmptyT)+    traverse f' (Seq (Single (Elem x'))) =+        (\x'' -> Seq (Single (Elem x''))) <$> f' x'+    traverse f' (Seq (Deep s' pr' m' sf')) =+        liftA3+            (\pr'' m'' sf'' -> Seq (Deep s' pr'' m'' sf''))+            (traverseDigitE f' pr')+            (traverseTree (traverseNodeE f') m')+            (traverseDigitE f' sf')+      where+        traverseTree+            :: Applicative f+            => (Node a -> f (Node b))+            -> FingerTree (Node a)+            -> f (FingerTree (Node b))+        traverseTree _ EmptyT = pure EmptyT+        traverseTree f (Single x) = Single <$> f x+        traverseTree f (Deep s pr m sf) =+            liftA3+                (Deep s)+                (traverseDigitN f pr)+                (traverseTree (traverseNodeN f) m)+                (traverseDigitN f sf)+        traverseDigitE+            :: Applicative f+            => (a -> f b) -> Digit (Elem a) -> f (Digit (Elem b))+        traverseDigitE f (One (Elem a)) =+            (\a' -> One (Elem a')) <$>+            f a+        traverseDigitE f (Two (Elem a) (Elem b)) =+            liftA2+                (\a' b' -> Two (Elem a') (Elem b'))+                (f a)+                (f b)+        traverseDigitE f (Three (Elem a) (Elem b) (Elem c)) =+            liftA3+                (\a' b' c' ->+                      Three (Elem a') (Elem b') (Elem c'))+                (f a)+                (f b)+                (f c)+        traverseDigitE f (Four (Elem a) (Elem b) (Elem c) (Elem d)) =+            liftA3+                (\a' b' c' d' -> Four (Elem a') (Elem b') (Elem c') (Elem d'))+                (f a)+                (f b)+                (f c) <*> +                (f d)+        traverseDigitN+            :: Applicative f+            => (Node a -> f (Node b)) -> Digit (Node a) -> f (Digit (Node b))+        traverseDigitN f t = traverse f t+        traverseNodeE+            :: Applicative f+            => (a -> f b) -> Node (Elem a) -> f (Node (Elem b))+        traverseNodeE f (Node2 s (Elem a) (Elem b)) =+            liftA2+                (\a' b' -> Node2 s (Elem a') (Elem b'))+                (f a)+                (f b)+        traverseNodeE f (Node3 s (Elem a) (Elem b) (Elem c)) =+            liftA3+                (\a' b' c' ->+                      Node3 s (Elem a') (Elem b') (Elem c'))+                (f a)+                (f b)+                (f c)+        traverseNodeN+            :: Applicative f+            => (Node a -> f (Node b)) -> Node (Node a) -> f (Node (Node b))+        traverseNodeN f t = traverse f t  instance NFData a => NFData (Seq a) where     rnf (Seq xs) = rnf xs@@ -885,6 +932,14 @@     deriving Show #endif +#ifdef __GLASGOW_HASKELL__+-- | @since 0.6.1+deriving instance Generic1 FingerTree++-- | @since 0.6.1+deriving instance Generic (FingerTree a)+#endif+ instance Sized a => Sized (FingerTree a) where     {-# SPECIALIZE instance Sized (FingerTree (Elem a)) #-}     {-# SPECIALIZE instance Sized (FingerTree (Node a)) #-}@@ -894,34 +949,125 @@  instance Foldable FingerTree where     foldMap _ EmptyT = mempty-    foldMap f (Single x) = f x-    foldMap f (Deep _ pr m sf) =-        foldMap f pr <> foldMap (foldMap f) m <> foldMap f sf+    foldMap f' (Single x') = f' x'+    foldMap f' (Deep _ pr' m' sf') = +        foldMapDigit f' pr' <>+        foldMapTree (foldMapNode f') m' <>+        foldMapDigit f' sf'+      where+        foldMapTree :: Monoid m => (Node a -> m) -> FingerTree (Node a) -> m+        foldMapTree _ EmptyT = mempty+        foldMapTree f (Single x) = f x+        foldMapTree f (Deep _ pr m sf) = +            foldMapDigitN f pr <>+            foldMapTree (foldMapNodeN f) m <>+            foldMapDigitN f sf -    foldr _ z EmptyT = z-    foldr f z (Single x) = x `f` z-    foldr f z (Deep _ pr m sf) =-        foldr f (foldr (flip (foldr f)) (foldr f z sf) m) pr+        foldMapDigit :: Monoid m => (a -> m) -> Digit a -> m+        foldMapDigit f t = foldDigit (<>) f t -    foldl _ z EmptyT = z-    foldl f z (Single x) = z `f` x-    foldl f z (Deep _ pr m sf) =-        foldl f (foldl (foldl f) (foldl f z pr) m) sf+        foldMapDigitN :: Monoid m => (Node a -> m) -> Digit (Node a) -> m+        foldMapDigitN f t = foldDigit (<>) f t -#if MIN_VERSION_base(4,6,0)-    foldr' _ z EmptyT = z-    foldr' f z (Single x) = f x z-    foldr' f z (Deep _ pr m sf) = foldr' f mres pr-        where !sfRes = foldr' f z sf-              !mres = foldr' (flip (foldr' f)) sfRes m+        foldMapNode :: Monoid m => (a -> m) -> Node a -> m+        foldMapNode f t = foldNode (<>) f t -    foldl' _ z EmptyT = z-    foldl' f z (Single x) = z `f` x-    foldl' f z (Deep _ pr m sf) = foldl' f mres sf-        where !prRes = foldl' f z pr-              !mres = foldl' (foldl' f) prRes m+        foldMapNodeN :: Monoid m => (Node a -> m) -> Node (Node a) -> m+        foldMapNodeN f t = foldNode (<>) f t+#if __GLASGOW_HASKELL__+    {-# INLINABLE foldMap #-} #endif +    foldr _ z' EmptyT = z'+    foldr f' z' (Single x') = x' `f'` z'+    foldr f' z' (Deep _ pr' m' sf') =+        foldrDigit f' (foldrTree (foldrNode f') (foldrDigit f' z' sf') m') pr'+      where+        foldrTree :: (Node a -> b -> b) -> b -> FingerTree (Node a) -> b+        foldrTree _ z EmptyT = z+        foldrTree f z (Single x) = x `f` z+        foldrTree f z (Deep _ pr m sf) =+            foldrDigitN f (foldrTree (foldrNodeN f) (foldrDigitN f z sf) m) pr++        foldrDigit :: (a -> b -> b) -> b -> Digit a -> b+        foldrDigit f z t = foldr f z t++        foldrDigitN :: (Node a -> b -> b) -> b -> Digit (Node a) -> b+        foldrDigitN f z t = foldr f z t++        foldrNode :: (a -> b -> b) -> Node a -> b -> b+        foldrNode f t z = foldr f z t++        foldrNodeN :: (Node a -> b -> b) -> Node (Node a) -> b -> b+        foldrNodeN f t z = foldr f z t+    {-# INLINE foldr #-}+++    foldl _ z' EmptyT = z'+    foldl f' z' (Single x') = z' `f'` x'+    foldl f' z' (Deep _ pr' m' sf') =+        foldlDigit f' (foldlTree (foldlNode f') (foldlDigit f' z' pr') m') sf'+      where+        foldlTree :: (b -> Node a -> b) -> b -> FingerTree (Node a) -> b+        foldlTree _ z EmptyT = z+        foldlTree f z (Single x) = z `f` x+        foldlTree f z (Deep _ pr m sf) =+            foldlDigitN f (foldlTree (foldlNodeN f) (foldlDigitN f z pr) m) sf++        foldlDigit :: (b -> a -> b) -> b -> Digit a -> b+        foldlDigit f z t = foldl f z t++        foldlDigitN :: (b -> Node a -> b) -> b -> Digit (Node a) -> b+        foldlDigitN f z t = foldl f z t++        foldlNode :: (b -> a -> b) -> b -> Node a -> b+        foldlNode f z t = foldl f z t++        foldlNodeN :: (b -> Node a -> b) -> b -> Node (Node a) -> b+        foldlNodeN f z t = foldl f z t+    {-# INLINE foldl #-}++    foldr' _ z' EmptyT = z'+    foldr' f' z' (Single x') = f' x' z'+    foldr' f' z' (Deep _ pr' m' sf') =+        (foldrDigit' f' $! (foldrTree' (foldrNode' f') $! (foldrDigit' f' z') sf') m') pr'+      where+        foldrTree' :: (Node a -> b -> b) -> b -> FingerTree (Node a) -> b+        foldrTree' _ z EmptyT = z+        foldrTree' f z (Single x) = f x $! z+        foldrTree' f z (Deep _ pr m sf) =+            (foldr' f $! (foldrTree' (foldrNodeN' f) $! (foldr' f $! z) sf) m) pr++        foldrDigit' :: (a -> b -> b) -> b -> Digit a -> b+        foldrDigit' f z t = foldr' f z t++        foldrNode' :: (a -> b -> b) -> Node a -> b -> b+        foldrNode' f t z = foldr' f z t++        foldrNodeN' :: (Node a -> b -> b) -> Node (Node a) -> b -> b+        foldrNodeN' f t z = foldr' f z t+    {-# INLINE foldr' #-}++    foldl' _ z' EmptyT = z'+    foldl' f' z' (Single x') = f' z' x'+    foldl' f' z' (Deep _ pr' m' sf') =+        (foldlDigit' f' $!+         (foldlTree' (foldlNode' f') $! (foldlDigit' f' z') pr') m')+            sf'+      where+        foldlTree' :: (b -> Node a -> b) -> b -> FingerTree (Node a) -> b+        foldlTree' _ z EmptyT = z+        foldlTree' f z (Single xs) = f z xs+        foldlTree' f z (Deep _ pr m sf) =+            (foldl' f $! (foldlTree' (foldl' f) $! foldl' f z pr) m) sf++        foldlDigit' :: (b -> a -> b) -> b -> Digit a -> b+        foldlDigit' f z t = foldl' f z t++        foldlNode' :: (b -> a -> b) -> b -> Node a -> b+        foldlNode' f z t = foldl' f z t+    {-# INLINE foldl' #-}+     foldr1 _ EmptyT = error "foldr1: empty sequence"     foldr1 _ (Single x) = x     foldr1 f (Deep _ pr m sf) =@@ -977,6 +1123,14 @@     deriving Show #endif +#ifdef __GLASGOW_HASKELL__+-- | @since 0.6.1+deriving instance Generic1 Digit++-- | @since 0.6.1+deriving instance Generic (Digit a)+#endif+ foldDigit :: (b -> b -> b) -> (a -> b) -> Digit a -> b foldDigit _     f (One a) = f a foldDigit (<+>) f (Two a b) = f a <+> f b@@ -991,23 +1145,25 @@     foldr f z (Two a b) = a `f` (b `f` z)     foldr f z (Three a b c) = a `f` (b `f` (c `f` z))     foldr f z (Four a b c d) = a `f` (b `f` (c `f` (d `f` z)))+    {-# INLINE foldr #-}      foldl f z (One a) = z `f` a     foldl f z (Two a b) = (z `f` a) `f` b     foldl f z (Three a b c) = ((z `f` a) `f` b) `f` c     foldl f z (Four a b c d) = (((z `f` a) `f` b) `f` c) `f` d+    {-# INLINE foldl #-} -#if MIN_VERSION_base(4,6,0)-    foldr' f z (One a) = a `f` z+    foldr' f z (One a) = f a z     foldr' f z (Two a b) = f a $! f b z     foldr' f z (Three a b c) = f a $! f b $! f c z     foldr' f z (Four a b c d) = f a $! f b $! f c $! f d z+    {-# INLINE foldr' #-}      foldl' f z (One a) = f z a     foldl' f z (Two a b) = (f $! f z a) b     foldl' f z (Three a b c) = (f $! (f $! f z a) b) c     foldl' f z (Four a b c d) = (f $! (f $! (f $! f z a) b) c) d-#endif+    {-# INLINE foldl' #-}      foldr1 _ (One a) = a     foldr1 f (Two a b) = a `f` b@@ -1068,6 +1224,14 @@     deriving Show #endif +#ifdef __GLASGOW_HASKELL__+-- | @since 0.6.1+deriving instance Generic1 Node++-- | @since 0.6.1+deriving instance Generic (Node a)+#endif+ foldNode :: (b -> b -> b) -> (a -> b) -> Node a -> b foldNode (<+>) f (Node2 _ a b) = f a <+> f b foldNode (<+>) f (Node3 _ a b c) = f a <+> f b <+> f c@@ -1078,17 +1242,19 @@      foldr f z (Node2 _ a b) = a `f` (b `f` z)     foldr f z (Node3 _ a b c) = a `f` (b `f` (c `f` z))+    {-# INLINE foldr #-}      foldl f z (Node2 _ a b) = (z `f` a) `f` b     foldl f z (Node3 _ a b c) = ((z `f` a) `f` b) `f` c+    {-# INLINE foldl #-} -#if MIN_VERSION_base(4,6,0)     foldr' f z (Node2 _ a b) = f a $! f b z     foldr' f z (Node3 _ a b c) = f a $! f b $! f c z+    {-# INLINE foldr' #-}      foldl' f z (Node2 _ a b) = (f $! f z a) b     foldl' f z (Node3 _ a b c) = (f $! (f $! f z a) b) c-#endif+    {-# INLINE foldl' #-}  instance Functor Node where     {-# INLINE fmap #-}@@ -1127,6 +1293,14 @@     deriving Show #endif +#ifdef __GLASGOW_HASKELL__+-- | @since 0.6.1+deriving instance Generic1 Elem++-- | @since 0.6.1+deriving instance Generic (Elem a)+#endif+ instance Sized (Elem a) where     size _ = 1 @@ -1147,10 +1321,8 @@ #else     foldMap f (Elem x) = f x     foldl f z (Elem x) = f z x-#if MIN_VERSION_base(4,6,0)     foldl' f z (Elem x) = f z x #endif-#endif  instance Traversable Elem where     traverse f (Elem x) = Elem <$> f x@@ -1698,14 +1870,12 @@     | a :< Seq a    -- ^ leftmost element and the rest of the sequence     deriving (Eq, Ord, Show, Read) -#if __GLASGOW_HASKELL__+#ifdef __GLASGOW_HASKELL__ deriving instance Data a => Data (ViewL a)-#endif-#if __GLASGOW_HASKELL__ >= 706+ -- | @since 0.5.8 deriving instance Generic1 ViewL-#endif-#if __GLASGOW_HASKELL__ >= 702+ -- | @since 0.5.8 deriving instance Generic (ViewL a) #endif@@ -1765,14 +1935,12 @@             -- and the rightmost element     deriving (Eq, Ord, Show, Read) -#if __GLASGOW_HASKELL__+#ifdef __GLASGOW_HASKELL__ deriving instance Data a => Data (ViewR a)-#endif-#if __GLASGOW_HASKELL__ >= 706+ -- | @since 0.5.8 deriving instance Generic1 ViewR-#endif-#if __GLASGOW_HASKELL__ >= 702+ -- | @since 0.5.8 deriving instance Generic (ViewR a) #endif@@ -4168,8 +4336,6 @@ -- Zipping ------------------------------------------------------------------------ --- MonadZip appeared in base 4.4.0-#if MIN_VERSION_base(4,4,0) -- We use a custom definition of munzip to avoid retaining -- memory longer than necessary. Using the default definition, if -- we write@@ -4188,12 +4354,11 @@ instance MonadZip Seq where   mzipWith = zipWith   munzip = unzip-#endif  -- | Unzip a sequence of pairs. -- -- @--- unzip ps = ps `'seq'` ('fmap' 'fst' ps) ('fmap' 'snd' ps)+-- unzip ps = ps ``seq`` ('fmap' 'fst' ps) ('fmap' 'snd' ps) -- @ -- -- Example:
Data/Sequence/Internal/Sorting.hs view
@@ -78,12 +78,16 @@ -- | \( O(n \log n) \).  'sort' sorts the specified 'Seq' by the natural -- ordering of its elements.  The sort is stable.  If stability is not -- required, 'unstableSort' can be slightly faster.+--+-- @since 0.3.0 sort :: Ord a => Seq a -> Seq a sort = sortBy compare  -- | \( O(n \log n) \).  'sortBy' sorts the specified 'Seq' according to the -- specified comparator.  The sort is stable.  If stability is not required, -- 'unstableSortBy' can be slightly faster.+--+-- @since 0.3.0 sortBy :: (a -> a -> Ordering) -> Seq a -> Seq a sortBy cmp (Seq xs) =     maybe@@ -110,6 +114,8 @@ -- If @f@ is very cheap (for example a record selector, or 'fst'), -- @'sortBy' ('compare' ``Data.Function.on`` f)@ will be faster than -- @'sortOn' f@.+--+-- @since 0.5.11 sortOn :: Ord b => (a -> b) -> Seq a -> Seq a sortOn f (Seq xs) =     maybe@@ -123,6 +129,8 @@  -- Notes on the implementation and choice of heap are available in -- the file sorting.md (in this directory).+--+-- @since 0.3.0 unstableSort :: Ord a => Seq a -> Seq a unstableSort = unstableSortBy compare @@ -130,6 +138,8 @@ -- takes an arbitrary comparator and sorts the specified sequence. -- The sort is not stable.  This algorithm is frequently faster and -- uses less memory than 'sortBy'.+--+-- @since 0.3.0 unstableSortBy :: (a -> a -> Ordering) -> Seq a -> Seq a unstableSortBy cmp (Seq xs) =     maybe@@ -156,6 +166,8 @@ -- If @f@ is very cheap (for example a record selector, or 'fst'), -- @'unstableSortBy' ('compare' ``Data.Function.on`` f)@ will be faster than -- @'unstableSortOn' f@.+--+-- @since 0.5.11 unstableSortOn :: Ord b => (a -> b) -> Seq a -> Seq a unstableSortOn f (Seq xs) =     maybe
Data/Set.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE CPP #-}-#if !defined(TESTING) && __GLASGOW_HASKELL__ >= 703+#if !defined(TESTING) && defined(__GLASGOW_HASKELL__) {-# LANGUAGE Safe #-} #endif @@ -72,33 +72,40 @@               Set(..) #endif -            -- * Operators-            , (\\)+            -- * Construction+            , empty+            , singleton+            , fromList+            , fromAscList+            , fromDescList+            , fromDistinctAscList+            , fromDistinctDescList+            , powerSet +            -- * Insertion+            , insert++            -- * Deletion+            , delete+             -- * Query-            , S.null-            , size             , member             , notMember             , lookupLT             , lookupGT             , lookupLE             , lookupGE+            , S.null+            , size             , isSubsetOf             , isProperSubsetOf             , disjoint -            -- * Construction-            , empty-            , singleton-            , insert-            , delete-            , powerSet-             -- * Combine             , union             , unions             , difference+            , (\\)             , intersection             , cartesianProduct             , disjointUnion@@ -152,15 +159,8 @@             -- ** List             , elems             , toList-            , fromList--            -- ** Ordered list             , toAscList             , toDescList-            , fromAscList-            , fromDescList-            , fromDistinctAscList-            , fromDistinctDescList              -- * Debugging             , showTree
Data/Set/Internal.hs view
@@ -4,7 +4,7 @@ #if __GLASGOW_HASKELL__ {-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-} #endif-#if !defined(TESTING) && __GLASGOW_HASKELL__ >= 703+#if !defined(TESTING) && defined(__GLASGOW_HASKELL__) {-# LANGUAGE Trustworthy #-} #endif #if __GLASGOW_HASKELL__ >= 708@@ -246,7 +246,6 @@ import Data.Typeable import Control.DeepSeq (NFData(rnf)) -import Utils.Containers.Internal.StrictFold import Utils.Containers.Internal.StrictPair import Utils.Containers.Internal.PtrEquality @@ -318,13 +317,10 @@             go (Bin 1 k _ _) = f k             go (Bin _ k l r) = go l `mappend` (f k `mappend` go r)     {-# INLINE foldMap #-}--#if MIN_VERSION_base(4,6,0)     foldl' = foldl'     {-# INLINE foldl' #-}     foldr' = foldr'     {-# INLINE foldr' #-}-#endif #if MIN_VERSION_base(4,8,0)     length = size     {-# INLINE length #-}@@ -604,7 +600,7 @@   -- | /O(n+m)/. Is this a subset?--- @(s1 `isSubsetOf` s2)@ tells whether @s1@ is a subset of @s2@.+-- @(s1 \`isSubsetOf\` s2)@ tells whether @s1@ is a subset of @s2@. isSubsetOf :: Ord a => Set a -> Set a -> Bool isSubsetOf t1 t2   = (size t1 <= size t2) && (isSubsetOfX t1 t2)@@ -705,8 +701,8 @@   Union. --------------------------------------------------------------------} -- | The union of a list of sets: (@'unions' == 'foldl' 'union' 'empty'@).-unions :: Ord a => [Set a] -> Set a-unions = foldlStrict union empty+unions :: (Foldable f, Ord a) => f (Set a) -> Set a+unions = Foldable.foldl' union empty #if __GLASGOW_HASKELL__ {-# INLINABLE unions #-} #endif@@ -715,8 +711,8 @@ -- equal elements are encountered. union :: Ord a => Set a -> Set a -> Set a union t1 Tip  = t1-union t1 (Bin _ x Tip Tip) = insertR x t1-union (Bin _ x Tip Tip) t2 = insert x t2+union t1 (Bin 1 x _ _) = insertR x t1+union (Bin 1 x _ _) t2 = insert x t2 union Tip t2  = t2 union t1@(Bin _ x l1 r1) t2 = case splitS x t2 of   (l2 :*: r2)@@ -973,7 +969,7 @@     not_ordered x (y : _) = x >= y     {-# INLINE not_ordered #-} -    fromList' t0 xs = foldlStrict ins t0 xs+    fromList' t0 xs = Foldable.foldl' ins t0 xs       where ins t x = insert x t      go !_ t [] = t@@ -1695,7 +1691,7 @@ -- | Calculate the power set of a set: the set of all its subsets. -- -- @--- t `member` powerSet s == t `isSubsetOf` s+-- t ``member`` powerSet s == t ``isSubsetOf`` s -- @ -- -- Example:@@ -1748,9 +1744,9 @@   mappend (MergeSet xs) (MergeSet ys) = MergeSet (merge xs ys) #endif --- | Calculate the disjoin union of two sets.+-- | Calculate the disjoint union of two sets. ----- @ disjointUnion xs ys = map Left xs `union` map Right ys @+-- @ disjointUnion xs ys = map Left xs ``union`` map Right ys @ -- -- Example: --
Data/Tree.hs view
@@ -2,11 +2,7 @@ {-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ {-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}-#endif-#if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE DeriveGeneric #-}-#endif-#if __GLASGOW_HASKELL__ >= 703 {-# LANGUAGE Trustworthy #-} #endif @@ -21,20 +17,38 @@ -- Maintainer  :  libraries@haskell.org -- Portability :  portable ----- Multi-way trees (/aka/ rose trees) and forests.+-- = Multi-way Trees and Forests --+-- The @'Tree' a@ type represents a lazy, possibly infinite, multi-way tree+-- (also known as a /rose tree/).+--+-- The @'Forest' a@ type represents a forest of @'Tree' a@s.+-- -----------------------------------------------------------------------------  module Data.Tree(-    Tree(..), Forest,-    -- * Two-dimensional drawing-    drawTree, drawForest,-    -- * Extraction-    flatten, levels, foldTree,-    -- * Building trees-    unfoldTree, unfoldForest,-    unfoldTreeM, unfoldForestM,-    unfoldTreeM_BF, unfoldForestM_BF,++    -- * Trees and Forests+      Tree(..)+    , Forest++    -- * Construction+    , unfoldTree+    , unfoldForest+    , unfoldTreeM+    , unfoldForestM+    , unfoldTreeM_BF+    , unfoldForestM_BF++    -- * Elimination+    , foldTree+    , flatten+    , levels++    -- * Ascii Drawings+    , drawTree+    , drawForest+     ) where  #if MIN_VERSION_base(4,8,0)@@ -56,16 +70,10 @@  #ifdef __GLASGOW_HASKELL__ import Data.Data (Data)-#endif-#if __GLASGOW_HASKELL__ >= 706 import GHC.Generics (Generic, Generic1)-#elif __GLASGOW_HASKELL__ >= 702-import GHC.Generics (Generic) #endif -#if MIN_VERSION_base(4,4,0) import Control.Monad.Zip (MonadZip (..))-#endif  #if MIN_VERSION_base(4,8,0) import Data.Coerce@@ -80,13 +88,12 @@ import Data.Functor ((<$)) #endif --- | Multi-way trees, also known as /rose trees/.+-- | Non-empty, possibly infinite, multi-way trees; also known as /rose trees/. data Tree a = Node {         rootLabel :: a,         -- ^ label value         subForest :: Forest a   -- ^ zero or more child trees     } #ifdef __GLASGOW_HASKELL__-#if __GLASGOW_HASKELL__ >= 802   deriving ( Eq            , Read            , Show@@ -94,16 +101,10 @@            , Generic  -- ^ @since 0.5.8            , Generic1 -- ^ @since 0.5.8            )-#elif __GLASGOW_HASKELL__ >= 706-  deriving (Eq, Read, Show, Data, Generic, Generic1)-#elif __GLASGOW_HASKELL__ >= 702-  deriving (Eq, Read, Show, Data, Generic) #else-  deriving (Eq, Read, Show, Data)-#endif-#else   deriving (Eq, Read, Show) #endif+ type Forest a = [Tree a]  #if MIN_VERSION_base(4,9,0)@@ -204,20 +205,48 @@ instance NFData a => NFData (Tree a) where     rnf (Node x ts) = rnf x `seq` rnf ts -#if MIN_VERSION_base(4,4,0) instance MonadZip Tree where   mzipWith f (Node a as) (Node b bs)     = Node (f a b) (mzipWith (mzipWith f) as bs)    munzip (Node (a, b) ts) = (Node a as, Node b bs)     where (as, bs) = munzip (map munzip ts)-#endif --- | Neat 2-dimensional drawing of a tree.+-- | 2-dimensional ASCII drawing of a tree.+--+-- ==== __Examples__+--+-- > putStr $ drawTree $ fmap show (Node 1 [Node 2 [], Node 3 []])+--+-- @+-- 1+-- |+-- +- 2+-- |+-- `- 3+-- @+-- drawTree :: Tree String -> String drawTree  = unlines . draw --- | Neat 2-dimensional drawing of a forest.+-- | 2-dimensional ASCII drawing of a forest.+--+-- ==== __Examples__+--+-- > putStr $ drawForest $ map (fmap show) [(Node 1 [Node 2 [], Node 3 []]), (Node 10 [Node 20 []])]+--+-- @+-- 1+-- |+-- +- 2+-- |+-- `- 3+--+-- 10+-- |+-- `- 20+-- @+-- drawForest :: Forest String -> String drawForest  = unlines . map drawTree @@ -232,34 +261,112 @@      shift first other = zipWith (++) (first : repeat other) --- | The elements of a tree in pre-order.+-- | Returns the elements of a tree in pre-order.+--+-- @+--+--   a+--  / \\    => [a,b,c]+-- b   c+-- @+--+-- ==== __Examples__+--+-- > flatten (Node 1 [Node 2 [], Node 3 []]) == [1,2,3] flatten :: Tree a -> [a] flatten t = squish t []   where squish (Node x ts) xs = x:Prelude.foldr squish xs ts --- | Lists of nodes at each level of the tree.+-- | Returns the list of nodes at each level of the tree.+--+-- @+--+--   a+--  / \\    => [[a], [b,c]]+-- b   c+-- @+--+-- ==== __Examples__+--+-- > levels (Node 1 [Node 2 [], Node 3 []]) == [[1],[2,3]]+-- levels :: Tree a -> [[a]] levels t =     map (map rootLabel) $         takeWhile (not . null) $         iterate (concatMap subForest) [t] --- | Catamorphism on trees.+-- | Fold a tree into a "summary" value in depth-first order. --+-- For each node in the tree, apply @f@ to the @rootLabel@ and the result+-- of applying @f@ to each @subForent@.+--+-- This is also known as the catamorphism on trees.+--+-- ==== __Examples__+--+-- Sum the values in a tree:+--+-- > foldTree (\x xs -> sum (x:xs)) (Node 1 [Node 2 [], Node 3 []]) == 6+--+-- Find the maximum value in the tree:+--+-- > foldTree (\x xs -> maximum (x:xs)) (Node 1 [Node 2 [], Node 3 []]) == 3+--+-- -- @since 0.5.8 foldTree :: (a -> [b] -> b) -> Tree a -> b foldTree f = go where     go (Node x ts) = f x (map go ts) --- | Build a tree from a seed value+-- | Build a (possibly infinite) tree from a seed value in breadth-first order.+--+-- @unfoldTree f b@ constructs a tree by starting with the tree+-- @Node { rootLabel=b, subForest=[] }@ and repeatedly applying @f@ to each+-- 'rootLabel' value in the tree's leaves to generate its 'subForest'.+--+-- For a monadic version see 'unfoldTreeM_BF'.+--+-- ==== __Examples__+--+-- Construct the tree of @Integer@s where each node has two children:+-- @left = 2*x@ and @right = 2*x + 1@, where @x@ is the 'rootLabel' of the node.+-- Stop when the values exceed 7.+--+-- > let buildNode x = if 2*x + 1 > 7 then (x, []) else (x, [2*x, 2*x+1])+-- > putStr $ drawTree $ fmap show $ unfoldTree buildNode 1+--+-- @+--+-- 1+-- |+-- +- 2+-- |  |+-- |  +- 4+-- |  |+-- |  `- 5+-- |+-- `- 3+--    |+--    +- 6+--    |+--    `- 7+-- @+-- unfoldTree :: (b -> (a, [b])) -> b -> Tree a unfoldTree f b = let (a, bs) = f b in Node a (unfoldForest f bs) --- | Build a forest from a list of seed values+-- | Build a (possibly infinite) forest from a list of seed values in+-- breadth-first order.+--+-- @unfoldForest f seeds@ invokes 'unfoldTree' on each seed value.+--+-- For a monadic version see 'unfoldForestM_BF'.+-- unfoldForest :: (b -> (a, [b])) -> [b] -> Forest a unfoldForest f = map (unfoldTree f) --- | Monadic tree builder, in depth-first order+-- | Monadic tree builder, in depth-first order. unfoldTreeM :: Monad m => (b -> m (a, [b])) -> b -> m (Tree a) unfoldTreeM f b = do     (a, bs) <- f b@@ -270,10 +377,12 @@ unfoldForestM :: Monad m => (b -> m (a, [b])) -> [b] -> m (Forest a) unfoldForestM f = Prelude.mapM (unfoldTreeM f) --- | Monadic tree builder, in breadth-first order,--- using an algorithm adapted from--- /Breadth-First Numbering: Lessons from a Small Exercise in Algorithm Design/,--- by Chris Okasaki, /ICFP'00/.+-- | Monadic tree builder, in breadth-first order.+--+-- See 'unfoldTree' for more info.+--+-- Implemented using an algorithm adapted from /Breadth-First Numbering: Lessons+-- from a Small Exercise in Algorithm Design/, by Chris Okasaki, /ICFP'00/. unfoldTreeM_BF :: Monad m => (b -> m (a, [b])) -> b -> m (Tree a) unfoldTreeM_BF f b = liftM getElement $ unfoldForestQ f (singleton b)   where@@ -281,15 +390,17 @@         x :< _ -> x         EmptyL -> error "unfoldTreeM_BF" --- | Monadic forest builder, in breadth-first order,--- using an algorithm adapted from--- /Breadth-First Numbering: Lessons from a Small Exercise in Algorithm Design/,--- by Chris Okasaki, /ICFP'00/.+-- | Monadic forest builder, in breadth-first order+--+-- See 'unfoldForest' for more info.+--+-- Implemented using an algorithm adapted from /Breadth-First Numbering: Lessons+-- from a Small Exercise in Algorithm Design/, by Chris Okasaki, /ICFP'00/. unfoldForestM_BF :: Monad m => (b -> m (a, [b])) -> [b] -> m (Forest a) unfoldForestM_BF f = liftM toList . unfoldForestQ f . fromList --- takes a sequence (queue) of seeds--- produces a sequence (reversed queue) of trees of the same length+-- Takes a sequence (queue) of seeds and produces a sequence (reversed queue) of+-- trees of the same length. unfoldForestQ :: Monad m => (b -> m (a, [b])) -> Seq b -> m (Seq (Tree a)) unfoldForestQ f aQ = case viewl aQ of     EmptyL -> return empty
Utils/Containers/Internal/BitQueue.hs view
@@ -51,22 +51,11 @@ import Data.Bits ((.|.), (.&.), testBit) #if MIN_VERSION_base(4,8,0) import Data.Bits (countTrailingZeros)-#elif MIN_VERSION_base(4,5,0)+#else import Data.Bits (popCount) #endif -#if !MIN_VERSION_base(4,5,0)--- We could almost certainly improve this fall-back (copied straight from the--- default definition in Data.Bits), but it hardly seems worth the trouble--- to speed things up on GHC 7.4 and below.-countTrailingZeros :: Word -> Int-countTrailingZeros x = go 0-      where-        go i | i >= wordSize      = i-             | testBit x i = i-             | otherwise   = go (i+1)--#elif !MIN_VERSION_base(4,8,0)+#if !MIN_VERSION_base(4,8,0) countTrailingZeros :: Word -> Int countTrailingZeros x = popCount ((x .&. (-x)) - 1) {-# INLINE countTrailingZeros #-}
Utils/Containers/Internal/BitUtil.hs view
@@ -2,7 +2,7 @@ #if __GLASGOW_HASKELL__ {-# LANGUAGE MagicHash #-} #endif-#if !defined(TESTING) && __GLASGOW_HASKELL__ >= 703+#if !defined(TESTING) && defined(__GLASGOW_HASKELL__) {-# LANGUAGE Safe #-} #endif @@ -39,11 +39,7 @@     ) where  import Data.Bits ((.|.), xor)-#if MIN_VERSION_base(4,5,0) import Data.Bits (popCount, unsafeShiftL, unsafeShiftR)-#else-import Data.Bits ((.&.), shiftL, shiftR)-#endif #if MIN_VERSION_base(4,7,0) import Data.Bits (finiteBitSize) #else@@ -67,13 +63,7 @@ ----------------------------------------------------------------------}  bitcount :: Int -> Word -> Int-#if MIN_VERSION_base(4,5,0) bitcount a x = a + popCount x-#else-bitcount a0 x0 = go a0 x0-  where go a 0 = a-        go a x = go (a + 1) (x .&. (x-1))-#endif {-# INLINE bitcount #-}  -- The highestBitMask implementation is based on@@ -97,13 +87,8 @@  -- Right and left logical shifts. shiftRL, shiftLL :: Word -> Int -> Word-#if MIN_VERSION_base(4,5,0) shiftRL = unsafeShiftR shiftLL = unsafeShiftL-#else-shiftRL = shiftR-shiftLL = shiftL-#endif  {-# INLINE wordSize #-} wordSize :: Int
+ Utils/Containers/Internal/Coercions.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS_HADDOCK hide #-}++#include "containers.h"++module Utils.Containers.Internal.Coercions where++#if __GLASGOW_HASKELL__ >= 708+import Data.Coerce+#endif++infixl 8 .#+#if __GLASGOW_HASKELL__ >= 708+(.#) :: Coercible b a => (b -> c) -> (a -> b) -> a -> c+(.#) f _ = coerce f+#else+(.#) :: (b -> c) -> (a -> b) -> a -> c+(.#) = (.)+#endif+{-# INLINE (.#) #-}++infix 9 .^#++-- | Coerce the second argument of a function. Conceptually,+-- can be thought of as:+--+-- @+--   (f .^# g) x y = f x (g y)+-- @+--+-- However it is most useful when coercing the arguments to+-- 'foldl':+--+-- @+--   foldl f b . fmap g = foldl (f .^# g) b+-- @+#if __GLASGOW_HASKELL__ >= 708+(.^#) :: Coercible c b => (a -> c -> d) -> (b -> c) -> (a -> b -> d)+(.^#) f _ = coerce f+#else+(.^#) :: (a -> c -> d) -> (b -> c) -> (a -> b -> d)+(f .^# g) x y = f x (g y)+#endif+{-# INLINE (.^#) #-}
− Utils/Containers/Internal/StrictFold.hs
@@ -1,20 +0,0 @@-{-# LANGUAGE CPP #-}-#if !defined(TESTING) && __GLASGOW_HASKELL__ >= 703-{-# LANGUAGE Safe #-}-#endif--#include "containers.h"-{-# OPTIONS_HADDOCK hide #-}--module Utils.Containers.Internal.StrictFold (foldlStrict) where---- | Same as regular 'Data.List.foldl'', but marked INLINE so that it is always--- inlined. This allows further optimization of the call to f, which can be--- optimized/specialised/inlined.--foldlStrict :: (a -> b -> a) -> a -> [b] -> a-foldlStrict f = go-  where-    go z []     = z-    go z (x:xs) = let z' = f z x in z' `seq` go z' xs-{-# INLINE foldlStrict #-}
Utils/Containers/Internal/StrictPair.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE CPP #-}-#if !defined(TESTING) && __GLASGOW_HASKELL__ >= 703+#if !defined(TESTING) && defined(__GLASGOW_HASKELL__) {-# LANGUAGE Safe #-} #endif 
+ Utils/Containers/Internal/TypeError.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE DataKinds, FlexibleInstances, FlexibleContexts, UndecidableInstances,+     KindSignatures, TypeFamilies, CPP #-}++#if !defined(TESTING)+# if __GLASGOW_HASKELL__ >= 710+{-# LANGUAGE Safe #-}+# else+{-# LANGUAGE Trustworthy #-}+#endif+#endif++-- | Unsatisfiable constraints for functions being removed.++module Utils.Containers.Internal.TypeError where+import GHC.TypeLits++-- | The constraint @Whoops s@ is unsatisfiable for every 'Symbol' @s@.+-- Under GHC 8.0 and above, trying to use a function with a @Whoops s@+-- constraint will lead to a pretty type error explaining how to fix+-- the problem. Under earlier GHC versions, it will produce an extremely+-- ugly type error within which the desired message is buried.+--+-- ==== Example+--+-- @+-- oldFunction :: Whoops "oldFunction is gone now. Use newFunction."+--             => Int -> IntMap a -> IntMap a+-- @+class Whoops (a :: Symbol)++#if __GLASGOW_HASKELL__ >= 800+instance TypeError ('Text a) => Whoops a+#endif++-- Why don't we just use+--+-- type Whoops a = TypeError ('Text a) ?+--+-- When GHC sees the type signature of oldFunction, it will see that it+-- has an unsatisfiable constraint and reject it out of hand.+--+-- It seems possible to hack around that with a type family:+--+-- type family Whoops a where+--   Whoops a = TypeError ('Text a)+--+-- but I don't really trust that to work reliably. What we actually+-- do is pretty much guaranteed to work. Despite the fact that there+-- is a totally polymorphic instance in scope, GHC will refrain from+-- reducing the constraint because it knows someone could (theoretically)+-- define an overlapping instance of Whoops. It doesn't commit to+-- the polymorphic one until it has to, at the call site.
benchmarks/Sequence.hs view
@@ -159,15 +159,15 @@          ]       , bgroup "unstableSortOn"          [ bgroup "already sorted"-            [ bench "10" $ nf S.unstableSortOn id s10-            , bench "100" $ nf S.unstableSortOn id s100-            , bench "1000" $ nf S.unstableSortOn id s1000-            , bench "10000" $ nf S.unstableSortOn id s10000]+            [ bench "10"    $ nf (S.unstableSortOn id) s10+            , bench "100"   $ nf (S.unstableSortOn id) s100+            , bench "1000"  $ nf (S.unstableSortOn id) s1000+            , bench "10000" $ nf (S.unstableSortOn id) s10000]          , bgroup "random"-            [ bench "10" $ nf S.unstableSortOn id rs10-            , bench "100" $ nf S.unstableSortOn id rs100-            , bench "1000" $ nf S.unstableSortOn id rs1000-            , bench "10000" $ nf S.unstableSortOn id rs10000]+            [ bench "10"    $ nf (S.unstableSortOn id) rs10+            , bench "100"   $ nf (S.unstableSortOn id) rs100+            , bench "1000"  $ nf (S.unstableSortOn id) rs1000+            , bench "10000" $ nf (S.unstableSortOn id) rs10000]          ]       ] 
changelog.md view
@@ -1,5 +1,61 @@ # Changelog for [`containers` package](http://github.com/haskell/containers) +## 0.6.0.1++* Released with GHC 8.6++### New functions and class instances++* Add `Data.Containers.ListUtils` offering `nub`-like functions. (Thanks to+  Gershom Bazerman for starting the process of writing these.)++* Add `Generic` and `Generic1` instances for key `Data.Sequence.Internal` types:+  `Node`, `Digit`, `Elem`, and `FingerTree`.++### Death of deprecated functions++The following functions have been disabled. As an experiment+in function removal technology, the functions are still temporarily present,+but any attempts to use them will result in type errors advising on+replacement.++* `Data.IntMap`: `insertWith'`, `insertWithKey'`, `fold`, and `foldWithKey`.++* `Data.Map`: `insertWith'`, `insertWithKey'`, `insertLookupWithKey'`,+   `fold`, and `foldWithKey`.++The same has been done for the deprecated exports of `showTree` and+`showTreeWith`. These function remain available in the internal `Debug`+modules.++### Changes to existing functions++* Generalize the types of `unions` and `unionsWith`. (Thanks, jwaldmann.)++### Performance improvements++* Speed up folds and `traverse` on sequences. (Thanks, Donnacha Oisín Kidney.)++* Speed up `Data.Set.union`. (Thanks, Joachim Breitner.)++* Speed up several algorithms in `Data.Graph` a bit by using unboxed arrays+  where appropriate.++* Implement `Data.Graph.indegree` directly instead of taking the transpose+  and calculating its `outdegree`. This may not lead to an immediate performance+  improvement (see [GHC Trac #14785](https://ghc.haskell.org/trac/ghc/ticket/14785))+  but it should be better eventually.++### Other package changes++* Drop support for GHC versions before 7.6.++* Improve `Data.Graph` documentation, and reorganize map and set documentation.++* Remove the `Data.Map.Lazy.Merge` and `Data.Map.Strict.Merge` modules. These+  were renamed and deprecated almost as soon as they were introduced.++ ## 0.5.11  * Released with GHC 8.4.
containers.cabal view
@@ -1,5 +1,5 @@ name: containers-version: 0.5.11.0+version: 0.6.0.1 license: BSD3 license-file: LICENSE maintainer: libraries@haskell.org@@ -40,7 +40,7 @@     location: http://github.com/haskell/containers.git  Library-    build-depends: base >= 4.3 && < 5, array, deepseq >= 1.2 && < 1.5+    build-depends: base >= 4.6 && < 5, array >= 0.4.0.0, deepseq >= 1.2 && < 1.5     if impl(ghc)         build-depends: ghc-prim @@ -49,6 +49,7 @@     other-extensions: CPP, BangPatterns      exposed-modules:+        Data.Containers.ListUtils         Data.IntMap         Data.IntMap.Lazy         Data.IntMap.Strict@@ -60,11 +61,9 @@         Data.IntSet         Data.Map         Data.Map.Lazy-        Data.Map.Lazy.Merge         Data.Map.Merge.Lazy         Data.Map.Strict.Internal         Data.Map.Strict-        Data.Map.Strict.Merge         Data.Map.Merge.Strict         Data.Map.Internal         Data.Map.Internal.Debug@@ -81,9 +80,12 @@      other-modules:         Utils.Containers.Internal.State-        Utils.Containers.Internal.StrictFold         Utils.Containers.Internal.StrictMaybe         Utils.Containers.Internal.PtrEquality+        Utils.Containers.Internal.Coercions+    if impl(ghc)+      other-modules:+        Utils.Containers.Internal.TypeError         Data.Map.Internal.DeprecatedShowTree         Data.IntMap.Internal.DeprecatedDebug @@ -99,7 +101,7 @@   main-is: IntMap.hs   ghc-options: -O2   build-depends:-    base >= 4.2 && < 5,+    base >= 4.6 && < 5,     containers,     criterion >= 0.4.0 && < 1.3,     deepseq >= 1.1.0.0 && < 1.5@@ -110,7 +112,7 @@   main-is: IntSet.hs   ghc-options: -O2   build-depends:-    base >= 4.2 && < 5,+    base >= 4.6 && < 5,     containers,     criterion >= 0.4.0 && < 1.3,     deepseq >= 1.1.0.0 && < 1.5@@ -121,7 +123,7 @@   main-is: Map.hs   ghc-options: -O2   build-depends:-    base >= 4.2 && < 5,+    base >= 4.6 && < 5,     containers,     criterion >= 0.4.0 && < 1.3,     deepseq >= 1.1.0.0 && < 1.5,@@ -133,7 +135,7 @@   main-is: Sequence.hs   ghc-options: -O2   build-depends:-    base >= 4.2 && < 5,+    base >= 4.6 && < 5,     containers,     criterion >= 0.4.0 && < 1.3,     deepseq >= 1.1.0.0 && < 1.5,@@ -146,7 +148,7 @@   main-is: Set.hs   ghc-options: -O2   build-depends:-    base >= 4.2 && < 5,+    base >= 4.6 && < 5,     containers,     criterion >= 0.4.0 && < 1.3,     deepseq >= 1.1.0.0 && < 1.5@@ -158,7 +160,7 @@   other-modules: SetOperations   ghc-options: -O2   build-depends:-    base >= 4.2 && < 5,+    base >= 4.6 && < 5,     containers,     criterion >= 0.4.0 && < 1.3 @@ -169,7 +171,7 @@   other-modules: SetOperations   ghc-options: -O2   build-depends:-    base >= 4.2 && < 5,+    base >= 4.6 && < 5,     containers,     criterion >= 0.4.0 && < 1.3 @@ -180,7 +182,7 @@   other-modules: SetOperations   ghc-options: -O2   build-depends:-    base >= 4.2 && < 5,+    base >= 4.6 && < 5,     containers,     criterion >= 0.4.0 && < 1.3 @@ -191,7 +193,7 @@   other-modules: SetOperations   ghc-options: -O2   build-depends:-    base >= 4.2 && < 5,+    base >= 4.6 && < 5,     containers,     criterion >= 0.4.0 && < 1.3 @@ -207,14 +209,14 @@       Data.IntSet.Internal       LookupGE_IntMap       Utils.Containers.Internal.BitUtil-      Utils.Containers.Internal.StrictFold       Utils.Containers.Internal.StrictPair+      Utils.Containers.Internal.TypeError   ghc-options: -O2   cpp-options: -DTESTING   other-modules:     Data.IntMap.Internal   build-depends:-    base >= 4.2 && < 5,+    base >= 4.6 && < 5,     containers,     criterion >= 0.4.0 && < 1.3,     deepseq >= 1.1.0.0 && < 1.5,@@ -236,7 +238,6 @@       Utils.Containers.Internal.BitQueue       Utils.Containers.Internal.BitUtil       Utils.Containers.Internal.PtrEquality-      Utils.Containers.Internal.StrictFold       Utils.Containers.Internal.StrictMaybe       Utils.Containers.Internal.StrictPair   ghc-options: -O2@@ -244,7 +245,7 @@   other-modules:     Data.Map.Internal   build-depends:-    base >= 4.2 && < 5,+    base >= 4.6 && < 5,     containers,     criterion >= 0.4.0 && < 1.3,     deepseq >= 1.1.0.0 && < 1.5,@@ -271,13 +272,12 @@         Utils.Containers.Internal.BitQueue         Utils.Containers.Internal.BitUtil         Utils.Containers.Internal.PtrEquality-        Utils.Containers.Internal.StrictFold         Utils.Containers.Internal.StrictMaybe         Utils.Containers.Internal.StrictPair     type: exitcode-stdio-1.0     cpp-options: -DTESTING -    build-depends: base >= 4.3 && < 5, array, deepseq >= 1.2 && < 1.5, ghc-prim+    build-depends: base >= 4.6 && < 5, array >= 0.4.0.0, deepseq >= 1.2 && < 1.5, ghc-prim     ghc-options: -O2     other-extensions: CPP, BangPatterns     include-dirs: include@@ -305,13 +305,12 @@         Utils.Containers.Internal.BitQueue         Utils.Containers.Internal.BitUtil         Utils.Containers.Internal.PtrEquality-        Utils.Containers.Internal.StrictFold         Utils.Containers.Internal.StrictMaybe         Utils.Containers.Internal.StrictPair     type: exitcode-stdio-1.0     cpp-options: -DTESTING -DSTRICT -    build-depends: base >= 4.3 && < 5, array, deepseq >= 1.2 && < 1.5, ghc-prim+    build-depends: base >= 4.6 && < 5, array >= 0.4.0.0, deepseq >= 1.2 && < 1.5, ghc-prim     ghc-options: -O2     other-extensions: CPP, BangPatterns     include-dirs: include@@ -333,7 +332,7 @@     type: exitcode-stdio-1.0     cpp-options: -DTESTING -    build-depends: base >= 4.3 && < 5, ghc-prim+    build-depends: base >= 4.6 && < 5, ghc-prim     ghc-options: -O2     other-extensions: CPP, BangPatterns     include-dirs: include@@ -353,12 +352,11 @@         Data.Set.Internal         Utils.Containers.Internal.BitUtil         Utils.Containers.Internal.PtrEquality-        Utils.Containers.Internal.StrictFold         Utils.Containers.Internal.StrictPair     type: exitcode-stdio-1.0     cpp-options: -DTESTING -    build-depends: base >= 4.3 && < 5, array, deepseq >= 1.2 && < 1.5, ghc-prim+    build-depends: base >= 4.6 && < 5, array >= 0.4.0.0, deepseq >= 1.2 && < 1.5, ghc-prim     ghc-options: -O2     other-extensions: CPP, BangPatterns     include-dirs: include@@ -383,12 +381,12 @@         Data.IntSet.Internal         IntMapValidity         Utils.Containers.Internal.BitUtil-        Utils.Containers.Internal.StrictFold         Utils.Containers.Internal.StrictPair+        Utils.Containers.Internal.TypeError     type: exitcode-stdio-1.0     cpp-options: -DTESTING -    build-depends: base >= 4.3 && < 5, array, deepseq >= 1.2 && < 1.5, ghc-prim+    build-depends: base >= 4.6 && < 5, array >= 0.4.0.0, deepseq >= 1.2 && < 1.5, ghc-prim     ghc-options: -O2     other-extensions: CPP, BangPatterns     include-dirs: include@@ -412,12 +410,12 @@         Data.IntSet.Internal         IntMapValidity         Utils.Containers.Internal.BitUtil-        Utils.Containers.Internal.StrictFold         Utils.Containers.Internal.StrictPair+        Utils.Containers.Internal.TypeError     type: exitcode-stdio-1.0     cpp-options: -DTESTING -DSTRICT -    build-depends: base >= 4.3 && < 5, array, deepseq >= 1.2 && < 1.5, ghc-prim+    build-depends: base >= 4.6 && < 5, array >= 0.4.0.0, deepseq >= 1.2 && < 1.5, ghc-prim     ghc-options: -O2     other-extensions: CPP, BangPatterns     include-dirs: include@@ -440,12 +438,11 @@         IntSetValidity         Utils.Containers.Internal.BitUtil         Utils.Containers.Internal.PtrEquality-        Utils.Containers.Internal.StrictFold         Utils.Containers.Internal.StrictPair     type: exitcode-stdio-1.0     cpp-options: -DTESTING -    build-depends: base >= 4.3 && < 5, array, deepseq >= 1.2 && < 1.5, ghc-prim+    build-depends: base >= 4.6 && < 5, array >= 0.4.0.0, deepseq >= 1.2 && < 1.5, ghc-prim     ghc-options: -O2     other-extensions: CPP, BangPatterns     include-dirs: include@@ -457,43 +454,6 @@         test-framework-hunit,         test-framework-quickcheck2 -Test-suite deprecated-properties-    hs-source-dirs: tests, .-    main-is: deprecated-properties.hs-    other-modules:-        Data.IntMap-        Data.IntMap.Internal-        Data.IntMap.Internal.DeprecatedDebug-        Data.IntMap.Lazy-        Data.IntMap.Strict-        Data.IntSet.Internal-        Data.Map-        Data.Map.Internal-        Data.Map.Internal.Debug-        Data.Map.Internal.DeprecatedShowTree-        Data.Map.Lazy-        Data.Map.Strict-        Data.Map.Strict.Internal-        Data.Set.Internal-        Utils.Containers.Internal.BitQueue-        Utils.Containers.Internal.BitUtil-        Utils.Containers.Internal.PtrEquality-        Utils.Containers.Internal.StrictFold-        Utils.Containers.Internal.StrictMaybe-        Utils.Containers.Internal.StrictPair-    type: exitcode-stdio-1.0-    cpp-options: -DTESTING--    build-depends: base >= 4.3 && < 5, array, deepseq >= 1.2 && < 1.5, ghc-prim-    ghc-options: -O2-    other-extensions: CPP, BangPatterns-    include-dirs: include--    build-depends:-        QuickCheck >= 2.7.1,-        test-framework,-        test-framework-quickcheck2- Test-suite seq-properties     hs-source-dirs: tests, .     main-is: seq-properties.hs@@ -504,7 +464,7 @@     type: exitcode-stdio-1.0     cpp-options: -DTESTING -    build-depends: base >= 4.3 && < 5, array, deepseq >= 1.2 && < 1.5, ghc-prim+    build-depends: base >= 4.6 && < 5, array >= 0.4.0.0, deepseq >= 1.2 && < 1.5, ghc-prim     ghc-options: -O2     other-extensions: CPP, BangPatterns     include-dirs: include@@ -523,7 +483,7 @@     type: exitcode-stdio-1.0     cpp-options: -DTESTING -    build-depends: base >= 4.3 && < 5, array, deepseq >= 1.2 && < 1.5, ghc-prim+    build-depends: base >= 4.6 && < 5, array >= 0.4.0.0, deepseq >= 1.2 && < 1.5, ghc-prim     ghc-options: -O2     other-extensions: CPP, BangPatterns     include-dirs: include@@ -547,14 +507,13 @@       Utils.Containers.Internal.BitQueue       Utils.Containers.Internal.BitUtil       Utils.Containers.Internal.PtrEquality-      Utils.Containers.Internal.StrictFold       Utils.Containers.Internal.StrictMaybe       Utils.Containers.Internal.StrictPair   type: exitcode-stdio-1.0    build-depends:-    array,-    base >= 4.3 && < 5,+    array >= 0.4.0.0,+    base >= 4.6 && < 5,     ChasingBottoms,     deepseq >= 1.2 && < 1.5,     QuickCheck >= 2.7.1,@@ -575,14 +534,14 @@       Data.IntMap.Strict       Data.IntSet.Internal       Utils.Containers.Internal.BitUtil-      Utils.Containers.Internal.StrictFold       Utils.Containers.Internal.StrictPair+      Utils.Containers.Internal.TypeError   type: exitcode-stdio-1.0   other-extensions: CPP, BangPatterns    build-depends:-    array,-    base >= 4.3 && < 5,+    array >= 0.4.0.0,+    base >= 4.6 && < 5,     ChasingBottoms,     deepseq >= 1.2 && < 1.5,     QuickCheck >= 2.7.1,@@ -600,14 +559,32 @@       Data.IntSet       Data.IntSet.Internal       Utils.Containers.Internal.BitUtil-      Utils.Containers.Internal.StrictFold       Utils.Containers.Internal.StrictPair   type: exitcode-stdio-1.0   other-extensions: CPP, BangPatterns    build-depends:-    array,-    base >= 4.3 && < 5,+    array >= 0.4.0.0,+    base >= 4.6 && < 5,+    ChasingBottoms,+    deepseq >= 1.2 && < 1.5,+    QuickCheck >= 2.7.1,+    ghc-prim,+    test-framework >= 0.3.3,+    test-framework-quickcheck2 >= 0.2.9++  ghc-options: -Wall+  include-dirs: include++test-suite listutils-properties+  hs-source-dirs: tests, .+  main-is: listutils-properties.hs+  other-modules:+      Data.Containers.ListUtils+  type: exitcode-stdio-1.0++  build-depends:+    base >= 4.6 && < 5,     ChasingBottoms,     deepseq >= 1.2 && < 1.5,     QuickCheck >= 2.7.1,
include/containers.h view
@@ -33,33 +33,9 @@ #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- * defining an approximate MIN_VERSION_base if needed. The alternative version- * guesses the version of base using the version of GHC. This is usually- * sufficiently accurate. However, it completely ignores minor version numbers,- * and it makes the assumption that a pre-release version of GHC will ship with- * base libraries with the same version numbers as the final release. This- * assumption is violated in certain stages of GHC development, but in practice- * this should very rarely matter, and will not affect any released version.- */-#ifndef MIN_VERSION_base-#if __GLASGOW_HASKELL__ >= 709-#define MIN_VERSION_base(major1,major2,minor) (((major1)<4)||(((major1) == 4)&&((major2)<=8)))-#elif __GLASGOW_HASKELL__ >= 707-#define MIN_VERSION_base(major1,major2,minor) (((major1)<4)||(((major1) == 4)&&((major2)<=7)))-#elif __GLASGOW_HASKELL__ >= 705-#define MIN_VERSION_base(major1,major2,minor) (((major1)<4)||(((major1) == 4)&&((major2)<=6)))-#elif __GLASGOW_HASKELL__ >= 703-#define MIN_VERSION_base(major1,major2,minor) (((major1)<4)||(((major1) == 4)&&((major2)<=5)))-#elif __GLASGOW_HASKELL__ >= 701-#define MIN_VERSION_base(major1,major2,minor) (((major1)<4)||(((major1) == 4)&&((major2)<=4)))-#elif __GLASGOW_HASKELL__ >= 700-#define MIN_VERSION_base(major1,major2,minor) (((major1)<4)||(((major1) == 4)&&((major2)<=3)))-#else-#define MIN_VERSION_base(major1,major2,minor) (0)-#endif+#ifdef __GLASGOW_HASKELL__+# define USE_ST_MONAD 1+# define USE_UNBOXED_ARRAYS 1 #endif  #endif
tests/IntMapValidity.hs view
@@ -46,10 +46,10 @@   case t of     Nil -> True     Tip _ _ -> True-    b@(Bin p _ _ _) -> all (sharedPrefix p) (keys b)+    b@(Bin p _ l r) -> all (sharedPrefix p) (keys b) && commonPrefix l && commonPrefix r   where     sharedPrefix :: Prefix -> Int -> Bool-    sharedPrefix p a = 0 == (p `xor` (p .&. a))+    sharedPrefix p a = p == p .&. a  -- Invariant: In Bin prefix mask left right, left consists of the elements that --            don't have the mask bit set; right is all the elements that do.@@ -60,4 +60,6 @@     Tip _ _ -> True     Bin _ binMask l r ->       all (\x -> zero x binMask) (keys l) &&-      all (\x -> not (zero x binMask)) (keys r)+      all (\x -> not (zero x binMask)) (keys r) &&+      maskRespected l &&+      maskRespected r
tests/IntSetValidity.hs view
@@ -49,10 +49,10 @@   case t of     Nil -> True     Tip _ _ -> True-    b@(Bin p _ _ _) -> all (sharedPrefix p) (elems b)+    b@(Bin p _ l r) -> all (sharedPrefix p) (elems b) && commonPrefix l && commonPrefix r   where     sharedPrefix :: Prefix -> Int -> Bool-    sharedPrefix p a = 0 == (p `xor` (p .&. a))+    sharedPrefix p a = p == p .&. a  -- Invariant: In Bin prefix mask left right, left consists of the elements that --            don't have the mask bit set; right is all the elements that do.@@ -63,7 +63,9 @@     Tip _ _ -> True     Bin _ binMask l r ->       all (\x -> zero x binMask) (elems l) &&-      all (\x -> not (zero x binMask)) (elems r)+      all (\x -> not (zero x binMask)) (elems r) &&+      maskRespected l &&+      maskRespected r  -- Invariant: The Prefix is zero for the last 5 (on 32 bit arches) or 6 bits --            (on 64 bit arches). The values of the set represented by a tip
− tests/deprecated-properties.hs
@@ -1,108 +0,0 @@-{-# LANGUAGE CPP #-}-{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}---- This module tests the deprecated properties of Data.Map and Data.IntMap,--- because these cannot be tested in either map-properties or--- intmap-properties, as these modules are designed to work with the .Lazy and--- .Strict modules.--import qualified Data.Map as M-import qualified Data.Map.Strict as SM-import qualified Data.IntMap as IM-import qualified Data.IntMap.Strict as SIM--import Test.Framework-import Test.Framework.Providers.QuickCheck2-import Test.QuickCheck.Function (Fun(..), apply)--default (Int)--main :: IO ()-main = defaultMain-         [ testProperty "Data.Map.insertWith' as Strict.insertWith" prop_mapInsertWith'Strict-         , testProperty "Data.Map.insertWith' undefined value" prop_mapInsertWith'Undefined-         , testProperty "Data.Map.insertWithKey' as Strict.insertWithKey" prop_mapInsertWithKey'Strict-         , testProperty "Data.Map.insertWithKey' undefined value" prop_mapInsertWithKey'Undefined-         , testProperty "Data.Map.insertLookupWithKey' as Strict.insertLookupWithKey" prop_mapInsertLookupWithKey'Strict-         , testProperty "Data.Map.insertLookupWithKey' undefined value" prop_mapInsertLookupWithKey'Undefined-         , testProperty "Data.IntMap.insertWith' as Strict.insertWith" prop_intmapInsertWith'Strict-         , testProperty "Data.IntMap.insertWith' undefined value" prop_intmapInsertWith'Undefined-         , testProperty "Data.IntMap.insertWithKey' as Strict.insertWithKey" prop_intmapInsertWithKey'Strict-         , testProperty "Data.IntMap.insertWithKey' undefined value" prop_intmapInsertWithKey'Undefined-         ]------------- Map properties -----------apply2 :: Fun (a, b) c -> a -> b -> c-apply2 f a b = apply f (a, b)--apply3 :: Fun (a, b, c) d -> a -> b -> c -> d-apply3 f a b c = apply f (a, b, c)--prop_mapInsertWith'Strict :: [(Int, Int)] -> Fun (Int, Int) Int -> [(Int, Int)] -> Bool-prop_mapInsertWith'Strict xs f kxxs =-  let m = M.fromList xs-      insertList ins = foldr (\(kx, x) -> ins (apply2 f) kx x) m kxxs-  in insertList M.insertWith' == insertList SM.insertWith--prop_mapInsertWith'Undefined :: [(Int, Int)] -> Bool-prop_mapInsertWith'Undefined xs =-  let m = M.fromList xs-      f _ x = x * 33-      insertList ins = foldr (\(kx, _) -> ins f kx undefined) m xs-  in insertList M.insertWith' == insertList M.insertWith--prop_mapInsertWithKey'Strict :: [(Int, Int)] -> Fun (Int, Int, Int) Int -> [(Int, Int)] -> Bool-prop_mapInsertWithKey'Strict xs f kxxs =-  let m = M.fromList xs-      insertList ins = foldr (\(kx, x) -> ins (apply3 f) kx x) m kxxs-  in insertList M.insertWithKey' == insertList SM.insertWithKey--prop_mapInsertWithKey'Undefined :: [(Int, Int)] -> Bool-prop_mapInsertWithKey'Undefined xs =-  let m = M.fromList xs-      f k _ x = (k + x) * 33-      insertList ins = foldr (\(kx, _) -> ins f kx undefined) m xs-  in insertList M.insertWithKey' == insertList M.insertWithKey--prop_mapInsertLookupWithKey'Strict :: [(Int, Int)] -> Fun (Int, Int, Int) Int -> [(Int, Int)] -> Bool-prop_mapInsertLookupWithKey'Strict xs f kxxs =-  let m = M.fromList xs-      insertLookupList insLkp = scanr (\(kx, x) (_, mp) -> insLkp (apply3 f) kx x mp) (Nothing, m) kxxs-  in insertLookupList M.insertLookupWithKey' == insertLookupList SM.insertLookupWithKey--prop_mapInsertLookupWithKey'Undefined :: [(Int, Int)] -> Bool-prop_mapInsertLookupWithKey'Undefined xs =-  let m = M.fromList xs-      f k _ x = (k + x) * 33-      insertLookupList insLkp = scanr (\(kx, _) (_, mp) -> insLkp f kx undefined mp) (Nothing, m) xs-  in insertLookupList M.insertLookupWithKey' == insertLookupList M.insertLookupWithKey------------- IntMap properties ------------prop_intmapInsertWith'Strict :: [(Int, Int)] -> Fun (Int, Int) Int -> [(Int, Int)] -> Bool-prop_intmapInsertWith'Strict xs f kxxs =-  let m = IM.fromList xs-      insertList ins = foldr (\(kx, x) -> ins (apply2 f) kx x) m kxxs-  in insertList IM.insertWith' == insertList SIM.insertWith--prop_intmapInsertWith'Undefined :: [(Int, Int)] -> Bool-prop_intmapInsertWith'Undefined xs =-  let m = IM.fromList xs-      f _ x = x * 33-      insertList ins = foldr (\(kx, _) -> ins f kx undefined) m xs-  in insertList IM.insertWith' == insertList IM.insertWith--prop_intmapInsertWithKey'Strict :: [(Int, Int)] -> Fun (Int, Int, Int) Int -> [(Int, Int)] -> Bool-prop_intmapInsertWithKey'Strict xs f kxxs =-  let m = IM.fromList xs-      insertList ins = foldr (\(kx, x) -> ins (apply3 f) kx x) m kxxs-  in insertList IM.insertWithKey' == insertList SIM.insertWithKey--prop_intmapInsertWithKey'Undefined :: [(Int, Int)] -> Bool-prop_intmapInsertWithKey'Undefined xs =-  let m = IM.fromList xs-      f k _ x = (k + x) * 33-      insertList ins = foldr (\(kx, _) -> ins f kx undefined) m xs-  in insertList IM.insertWithKey' == insertList IM.insertWithKey
+ tests/graph-properties.hs view
@@ -0,0 +1,111 @@+{-# LANGUAGE CPP #-}++import Data.Graph as G++import Control.Applicative (Const(Const, getConst), pure, (<$>), (<*>), liftA2)++import Test.Framework+import Test.Framework.Providers.QuickCheck2+import Test.QuickCheck+import Test.QuickCheck.Function (Fun (..), apply)+import Test.QuickCheck.Poly (A, B, C)+import Control.Monad (ap)++default (Int)++main :: IO ()+main = defaultMain+         [+           testProperty "monad_id1"                prop_monad_id1+         , testProperty "monad_id2"                prop_monad_id2+         , testProperty "monad_assoc"              prop_monad_assoc+         , testProperty "ap_ap"                    prop_ap_ap+         , testProperty "ap_liftA2"                prop_ap_liftA2+         , testProperty "monadFix_ls"              prop_monadFix_ls+         ]++{--------------------------------------------------------------------+  Arbitrary trees+--------------------------------------------------------------------}++newtype G = G Graph++-- This instance isn't balanced very well; the trees will probably tend+-- to lean left. But it's better than nothing and we can fix it later.+instance Arbitrary a => Arbitrary G where+  arbitrary = sized arbgraph+    where+      arbgraph :: Arbitrary a => Int -> Gen G+      arbgraph nv = do+        lo <- arbitrary+        hi <- (lo+) <$> choose (0, nv)+{-+      arbtree 0 = fmap ((,) 1) $ Node <$> arbitrary <*> pure []+      arbtree n = do+        root <- arbitrary+        num_children <- choose (0, n - 1)+        (st, tl) <- go num_children+        return (1+st, Node root tl)+-}++      go 0 = pure (0, [])+      go n = do+        (sh, hd) <- arbtree n+        (st, tl) <- go (n - sh)+        pure (sh + st, hd : tl)++-- genericShrink only became available when generics did, so it's+-- not available under GHC 7.0.+#if __GLASGOW_HASKELL__ >= 704+  shrink = genericShrink+#endif++----------------------------------------------------------------+-- Unit tests+----------------------------------------------------------------++----------------------------------------------------------------+-- QuickCheck+----------------------------------------------------------------++apply2 :: Fun (a, b) c -> a -> b -> c+apply2 f a b = apply f (a, b)++prop_ap_ap :: Tree (Fun A B) -> Tree A -> Property+prop_ap_ap fs xs = (apply <$> fs <*> xs) === ((apply <$> fs) `ap` xs)++prop_ap_liftA2 :: Fun (A, B) C -> Tree A -> Tree B -> Property+prop_ap_liftA2 f as bs = (apply2 f <$> as <*> bs) === liftA2 (apply2 f) as bs++prop_monad_id1 :: Tree A -> Property+prop_monad_id1 t = (t >>= pure) === t++prop_monad_id2 :: A -> Fun A (Tree B) -> Property+prop_monad_id2 a f = (pure a >>= apply f) === apply f a++prop_monad_assoc :: Tree A -> Fun A (Tree B) -> Fun B (Tree C) -> Property+prop_monad_assoc ta atb btc =+  ((ta >>= apply atb) >>= apply btc)+  ===+  (ta >>= \a -> apply atb a >>= apply btc)++-- The left shrinking law+--+-- This test is kind of wonky and unprincipled, because it's+-- rather tricky to construct test cases!+-- This is the most important MonadFix law to test because it's the+-- least intuitive by far, and because it's the only one that's+-- sensitive to the Monad instance.+prop_monadFix_ls :: Int -> Tree Int -> Fun Int (Tree Int) -> Property+prop_monadFix_ls val ta ti =+  fmap ($val) (mfix (\x -> ta >>= \y -> f x y))+  ===+  fmap ($val) (ta >>= \y -> mfix (\x -> f x y))+  where+    fact :: Int -> (Int -> Int) -> Int -> Int+    fact x _ 0 = x + 1+    fact x f n = x + n * f ((n - 1) `mod` 23)++    f :: (Int -> Int) -> Int -> Tree (Int -> Int)+    f q y = let t = apply ti y+            in fmap (\w -> fact w q) t
tests/intset-properties.hs view
@@ -1,10 +1,6 @@ {-# LANGUAGE CPP #-}-#if MIN_VERSION_base(4,5,0) import Data.Bits ((.&.), popCount) import Data.Word (Word)-#else-import Data.Bits ((.&.))-#endif import Data.IntSet import Data.List (nub,sort) import qualified Data.List as List@@ -72,9 +68,7 @@                    , testProperty "prop_splitRoot" prop_splitRoot                    , testProperty "prop_partition" prop_partition                    , testProperty "prop_filter" prop_filter-#if MIN_VERSION_base(4,5,0)                    , testProperty "prop_bitcount" prop_bitcount-#endif                    ]  ----------------------------------------------------------------@@ -397,7 +391,6 @@      valid evens .&&.      parts === (odds, evens) -#if MIN_VERSION_base(4,5,0) prop_bitcount :: Int -> Word -> Bool prop_bitcount a w = bitcount_orig a w == bitcount_new a w   where@@ -405,5 +398,3 @@       where go a 0 = a             go a x = go (a + 1) (x .&. (x-1))     bitcount_new a x = a + popCount x-#endif-
+ tests/listutils-properties.hs view
@@ -0,0 +1,60 @@+module Main where++import Data.List (nub, nubBy)+import Data.Containers.ListUtils+import Test.Framework+import Test.Framework.Providers.QuickCheck2+import Test.QuickCheck (Property, (===))+import Test.QuickCheck.Function (Fun, apply)+import Test.QuickCheck.Poly (A, OrdA, B, OrdB, C)++main :: IO ()+main = defaultMain+         [ testProperty "nubOrd" prop_nubOrd+         , testProperty "nubOrdOn" prop_nubOrdOn+         , testProperty "nubOrdOn fusion" prop_nubOrdOnFusion+         , testProperty "nubInt" prop_nubInt+         , testProperty "nubIntOn" prop_nubIntOn+         , testProperty "nubIntOn fusion" prop_nubIntOnFusion+         ]+++prop_nubOrd :: [OrdA] -> Property+prop_nubOrd xs = nubOrd xs === nub xs++prop_nubInt :: [Int] -> Property+prop_nubInt xs = nubInt xs === nub xs++prop_nubOrdOn :: Fun A OrdB -> [A] -> Property+prop_nubOrdOn f' xs =+  nubOrdOn f xs === nubBy (\x y -> f x == f y) xs+  where f = apply f'++prop_nubIntOn :: Fun A Int -> [A] -> Property+prop_nubIntOn f' xs =+  nubIntOn f xs === nubBy (\x y -> f x == f y) xs+  where f = apply f'++prop_nubOrdOnFusion :: Fun B C+                    -> Fun B OrdB+                    -> Fun A B+                    -> [A] -> Property+prop_nubOrdOnFusion f' g' h' xs =+  (map f . nubOrdOn g . map h $ xs)+    === (map f . nubBy (\x y -> g x == g y) . map h $ xs)+  where+    f = apply f'+    g = apply g'+    h = apply h'++prop_nubIntOnFusion :: Fun B C+                    -> Fun B Int+                    -> Fun A B+                    -> [A] -> Property+prop_nubIntOnFusion f' g' h' xs =+  (map f . nubIntOn g . map h $ xs)+    === (map f . nubBy (\x y -> g x == g y) . map h $ xs)+  where+    f = apply f'+    g = apply g'+    h = apply h'
tests/seq-properties.hs view
@@ -41,9 +41,7 @@ import Test.QuickCheck.Function import Test.Framework import Test.Framework.Providers.QuickCheck2-#if MIN_VERSION_base(4,4,0) import Control.Monad.Zip (MonadZip (..))-#endif import Control.DeepSeq (deepseq) import Control.Monad.Fix (MonadFix (..)) @@ -54,9 +52,11 @@        , testProperty "(<$)" prop_constmap        , testProperty "foldr" prop_foldr        , testProperty "foldr'" prop_foldr'+       , testProperty "lazy foldr'" prop_lazyfoldr'        , testProperty "foldr1" prop_foldr1        , testProperty "foldl" prop_foldl        , testProperty "foldl'" prop_foldl'+       , testProperty "lazy foldl'" prop_lazyfoldl'        , testProperty "foldl1" prop_foldl1        , testProperty "(==)" prop_equals        , testProperty "compare" prop_compare@@ -95,8 +95,10 @@        , testProperty "partition" prop_partition        , testProperty "filter" prop_filter        , testProperty "sort" prop_sort+       , testProperty "sortStable" prop_sortStable        , testProperty "sortBy" prop_sortBy        , testProperty "sortOn" prop_sortOn+       , testProperty "sortOnStable" prop_sortOnStable        , testProperty "unstableSort" prop_unstableSort        , testProperty "unstableSortBy" prop_unstableSortBy        , testProperty "unstableSortOn" prop_unstableSortOn@@ -131,11 +133,9 @@        , testProperty "zipWith3" prop_zipWith3        , testProperty "zip4" prop_zip4        , testProperty "zipWith4" prop_zipWith4-#if MIN_VERSION_base(4,4,0)        , testProperty "mzip-naturality" prop_mzipNaturality        , testProperty "mzip-preservation" prop_mzipPreservation        , testProperty "munzip-lazy" prop_munzipLazy-#endif        , testProperty "<*>" prop_ap        , testProperty "<*> NOINLINE" prop_ap_NOINLINE        , testProperty "liftA2" prop_liftA2@@ -306,6 +306,16 @@     f = (:)     z = [] +prop_lazyfoldr' :: Seq () -> Property+prop_lazyfoldr' xs =+    not (null xs) ==>+    foldr'+        (\e _ ->+              e)+        (error "Data.Sequence.foldr': should be lazy in initial accumulator")+        xs ===+    ()+ prop_foldr1 :: Seq Int -> Property prop_foldr1 xs =     not (null xs) ==> foldr1 f xs == Data.List.foldr1 f (toList xs)@@ -325,6 +335,16 @@     f = flip (:)     z = [] +prop_lazyfoldl' :: Seq () -> Property+prop_lazyfoldl' xs =+    not (null xs) ==>+    foldl'+        (\_ e ->+              e)+        (error "Data.Sequence.foldl': should be lazy in initial accumulator")+        xs ===+    ()+ prop_foldl1 :: Seq Int -> Property prop_foldl1 xs =     not (null xs) ==> foldl1 f xs == Data.List.foldl1 f (toList xs)@@ -538,6 +558,30 @@ prop_sort xs =     toList' (sort xs) ~= Data.List.sort (toList xs) +data UnstableOrd = UnstableOrd+    { ordKey :: OrdA+    , _ignored :: A+    } deriving (Show)++instance Eq UnstableOrd where+    x == y = compare x y == EQ++instance Ord UnstableOrd where+    compare (UnstableOrd x _) (UnstableOrd y _) = compare x y++instance Arbitrary UnstableOrd where+    arbitrary = liftA2 UnstableOrd arbitrary arbitrary+    shrink (UnstableOrd x y) =+        [ UnstableOrd x' y'+        | (x',y') <- shrink (x, y) ]++prop_sortStable :: Seq UnstableOrd -> Bool+prop_sortStable xs =+    (fmap . fmap) unignore (toList' (sort xs)) ~=+    fmap unignore (Data.List.sort (toList xs))+  where+    unignore (UnstableOrd x y) = (x, y)+ prop_sortBy :: Seq (OrdA, B) -> Bool prop_sortBy xs =     toList' (sortBy f xs) ~= Data.List.sortBy f (toList xs)@@ -553,6 +597,16 @@     listSortOn k = Data.List.sortBy (compare `on` k) #endif +prop_sortOnStable :: Fun A UnstableOrd -> Seq A -> Bool+prop_sortOnStable (Fun _ f) xs =+    toList' (sortOn f xs) ~= listSortOn f (toList xs)+  where+#if MIN_VERSION_base(4,8,0)+    listSortOn = Data.List.sortOn+#else+    listSortOn k = Data.List.sortBy (compare `on` k)+#endif+ prop_unstableSort :: Seq OrdA -> Bool prop_unstableSort xs =     toList' (unstableSort xs) ~= Data.List.sort (toList xs)@@ -732,7 +786,6 @@     toList' (zipWith4 f xs ys zs ts) ~= Data.List.zipWith4 f (toList xs) (toList ys) (toList zs) (toList ts)   where f = (,,,) -#if MIN_VERSION_base(4,4,0) -- This comes straight from the MonadZip documentation prop_mzipNaturality :: Fun A C -> Fun B D -> Seq A -> Seq B -> Property prop_mzipNaturality f g sa sb =@@ -759,7 +812,6 @@     firstPieces = fmap (fst . munzip) partialpairs     repaired = mapWithIndex (\i s -> update i 10000 s) firstPieces     err = error "munzip isn't lazy enough"-#endif  -- Applicative operations 
tests/tree-properties.hs view
@@ -49,9 +49,7 @@         (st, tl) <- go (n - sh)         pure (sh + st, hd : tl) --- genericShrink only became available when generics did, so it's--- not available under GHC 7.0.-#if __GLASGOW_HASKELL__ >= 704+#if defined(__GLASGOW_HASKELL__)   shrink = genericShrink #endif