General package stuff, mostly

* Rename the internals again. I think they're getting close to
reasonable now. Get the cabal benchmarks running again. Deprecate
the "deprecated" `IntMap` stuff. Make a `Debug` module for the
`Data.Map` debugging functions.

* Rewrite `Data.Map.Internal.Debug.validSize` to use the
  `Monad Maybe` instance for clarity.

Author: treeowl

.travis.yml

@@ -28,17 +28,23 @@ before_install:
 install:
  - travis_retry cabal update
  - cabal install --only-dependencies
- # we need to install the test-suite deps manually as the cabal solver would
- # otherwise complaing about cyclic deps
+ # we need to install the test-suite and benchmark deps manually as the cabal
+ # solver would otherwise complain about cyclic deps
  - cabal install 'test-framework >= 0.3.3' 'test-framework-quickcheck2 >= 0.2.9' 'QuickCheck >= 2.4.0.1' 'ChasingBottoms' 'HUnit' 'test-framework-hunit'
 
+ # If we enable benchmarks, we'll need 'criterion >= 0.4.0 && < 1.2'
+
 # Here starts the actual work to be performed for the package under
 # test; any command which exits with a non-zero exit code causes the
 # build to fail.
 script:
  # -v2 provides useful information for debugging
  - cabal configure -v2 --enable-tests
 
+ # We'd like to
+ # --enable-benchmarks
+ # but CI time goes through the roof. Maybe there's a way to limit it to just one GHC version?
+
  # this builds all libraries and executables
  # (including tests/benchmarks)
  - cabal build

Data/IntMap.hs

@@ -65,38 +65,33 @@ import Prelude ()  -- hide foldr
 import qualified Data.IntMap.Strict as Strict
 import Data.IntMap.Lazy
 
--- | /Deprecated./ As of version 0.5, replaced by
--- 'Data.IntMap.Strict.insertWith'.
---
--- /O(log n)/. Same as 'insertWith', but the result of the combining function
+-- | /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
 
--- | /Deprecated./ As of version 0.5, replaced by
--- 'Data.IntMap.Strict.insertWithKey'.
---
--- /O(log n)/. Same as 'insertWithKey', but the result of the combining
+-- | /O(log n)/. Same as 'insertWithKey', but the result of the combining
 -- function is evaluated to WHNF before inserted to the map.
 
+{-# 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
 
--- | /Deprecated./ As of version 0.5, replaced by 'foldr'.
---
--- /O(n)/. Fold the values in the map using the given
+-- | /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 #-}
 
--- | /Deprecated./ As of version 0.5, replaced by 'foldrWithKey'.
---
--- /O(n)/. Fold the keys and values in the map using the given
+-- | /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.5, replaced by 'foldrWithKey'." #-}
 foldWithKey :: (Key -> a -> b -> b) -> b -> IntMap a -> b
 foldWithKey = foldrWithKey
 {-# INLINE foldWithKey #-}

Data/IntMap/Internal.hs

@@ -256,9 +256,9 @@ import Prelude hiding (lookup, map, filter, foldr, foldl, null)
 
 import Data.IntSet.Internal (Key)
 import qualified Data.IntSet.Internal as IntSet
-import Data.Utils.BitUtil
-import Data.Utils.StrictFold
-import Data.Utils.StrictPair
+import Utils.Containers.Internal.BitUtil
+import Utils.Containers.Internal.StrictFold
+import Utils.Containers.Internal.StrictPair
 
 #if __GLASGOW_HASKELL__
 import Data.Data (Data(..), Constr, mkConstr, constrIndex, Fixity(Prefix),

Data/IntMap/Strict.hs

@@ -265,9 +265,9 @@ import Data.IntMap.Internal hiding
     )
 
 import qualified Data.IntSet.Internal as IntSet
-import Data.Utils.BitUtil
-import Data.Utils.StrictFold
-import Data.Utils.StrictPair
+import Utils.Containers.Internal.BitUtil
+import Utils.Containers.Internal.StrictFold
+import Utils.Containers.Internal.StrictPair
 #if __GLASGOW_HASKELL__ >= 709
 import Data.Coerce
 #endif

Data/IntSet/Internal.hs

@@ -194,9 +194,9 @@ import Data.Semigroup (Semigroup((<>), stimes), stimesIdempotentMonoid)
 import Data.Typeable
 import Prelude hiding (filter, foldr, foldl, null, map)
 
-import Data.Utils.BitUtil
-import Data.Utils.StrictFold
-import Data.Utils.StrictPair
+import Utils.Containers.Internal.BitUtil
+import Utils.Containers.Internal.StrictFold
+import Utils.Containers.Internal.StrictPair
 
 #if __GLASGOW_HASKELL__
 import Data.Data (Data(..), Constr, mkConstr, constrIndex, Fixity(Prefix), DataType, mkDataType)

Data/Map/Internal.hs

@@ -327,11 +327,6 @@ module Data.Map.Internal (
     , minViewWithKey
     , maxViewWithKey
 
-    -- * Debugging
-    , showTree
-    , showTreeWith
-    , valid
-
     -- Used by the strict version
     , AreWeStrict (..)
     , atKeyImpl
@@ -340,7 +335,6 @@ module Data.Map.Internal (
 #endif
     , bin
     , balance
-    , balanced
     , balanceL
     , balanceR
     , delta
@@ -380,13 +374,13 @@ import Prelude hiding (lookup, map, filter, foldr, foldl, null, splitAt, take, d
 
 import qualified Data.Set.Internal as Set
 import Data.Set.Internal (Set)
-import Data.Utils.PtrEquality (ptrEq)
-import Data.Utils.StrictFold
-import Data.Utils.StrictPair
-import Data.Utils.StrictMaybe
-import Data.Utils.BitQueue
+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
 #if DEFINE_ALTERF_FALLBACK
-import Data.Utils.BitUtil (wordSize)
+import Utils.Containers.Internal.BitUtil (wordSize)
 #endif
 
 #if __GLASGOW_HASKELL__
@@ -3961,148 +3955,12 @@ instance (Show k, Show a) => Show (Map k a) where
   showsPrec d m  = showParen (d > 10) $
     showString "fromList " . shows (toList m)
 
--- | /O(n)/. Show the tree that implements the map. The tree is shown
--- in a compressed, hanging format. See 'showTreeWith'.
-{-# DEPRECATED showTree "This function is being removed from the public API." #-}
-showTree :: (Show k,Show a) => Map k a -> String
-showTree m
-  = showTreeWith showElem True False m
-  where
-    showElem k x  = show k ++ ":=" ++ show x
-
-
-{- | /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.
-
->  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,())
-
--}
-{-# DEPRECATED showTreeWith "This function is being removed from the public API." #-}
-showTreeWith :: (k -> a -> String) -> Bool -> Bool -> Map k a -> String
-showTreeWith showelem hang wide t
-  | hang      = (showsTreeHang showelem wide [] t) ""
-  | otherwise = (showsTree showelem wide [] [] t) ""
-
-showsTree :: (k -> a -> String) -> Bool -> [String] -> [String] -> Map k a -> ShowS
-showsTree showelem wide lbars rbars t
-  = case t of
-      Tip -> showsBars lbars . showString "|\n"
-      Bin _ kx x Tip Tip
-          -> showsBars lbars . showString (showelem kx x) . showString "\n"
-      Bin _ kx x l r
-          -> showsTree showelem wide (withBar rbars) (withEmpty rbars) r .
-             showWide wide rbars .
-             showsBars lbars . showString (showelem kx x) . showString "\n" .
-             showWide wide lbars .
-             showsTree showelem wide (withEmpty lbars) (withBar lbars) l
-
-showsTreeHang :: (k -> a -> String) -> Bool -> [String] -> Map k a -> ShowS
-showsTreeHang showelem wide bars t
-  = case t of
-      Tip -> showsBars bars . showString "|\n"
-      Bin _ kx x Tip Tip
-          -> showsBars bars . showString (showelem kx x) . showString "\n"
-      Bin _ kx x l r
-          -> showsBars bars . showString (showelem kx x) . showString "\n" .
-             showWide wide bars .
-             showsTreeHang showelem wide (withBar bars) l .
-             showWide wide bars .
-             showsTreeHang showelem wide (withEmpty bars) r
-
-showWide :: Bool -> [String] -> String -> String
-showWide wide bars
-  | wide      = showString (concat (reverse bars)) . showString "|\n"
-  | otherwise = id
-
-showsBars :: [String] -> ShowS
-showsBars bars
-  = case bars of
-      [] -> id
-      _  -> showString (concat (reverse (tail bars))) . showString node
-
-node :: String
-node           = "+--"
-
-withBar, withEmpty :: [String] -> [String]
-withBar bars   = "|  ":bars
-withEmpty bars = "   ":bars
-
 {--------------------------------------------------------------------
   Typeable
 --------------------------------------------------------------------}
 
 INSTANCE_TYPEABLE2(Map)
 
-{--------------------------------------------------------------------
-  Assertions
---------------------------------------------------------------------}
--- | /O(n)/. Test if the internal map structure is valid.
---
--- > valid (fromAscList [(3,"b"), (5,"a")]) == True
--- > valid (fromAscList [(5,"a"), (3,"b")]) == False
-
-valid :: Ord k => Map k a -> Bool
-valid t
-  = balanced t && ordered t && validsize t
-
-ordered :: Ord a => Map a b -> Bool
-ordered t
-  = bounded (const True) (const True) t
-  where
-    bounded lo hi t'
-      = case t' of
-          Tip              -> True
-          Bin _ kx _ l r  -> (lo kx) && (hi kx) && bounded lo (<kx) l && bounded (>kx) hi r
-
--- | Exported only for "Debug.QuickCheck"
-balanced :: Map k a -> Bool
-balanced t
-  = case t of
-      Tip            -> True
-      Bin _ _ _ l r  -> (size l + size r <= 1 || (size l <= delta*size r && size r <= delta*size l)) &&
-                        balanced l && balanced r
-
-validsize :: Map a b -> Bool
-validsize t
-  = (realsize t == Just (size t))
-  where
-    realsize t'
-      = case t' of
-          Tip            -> Just 0
-          Bin sz _ _ l r -> case (realsize l,realsize r) of
-                            (Just n,Just m)  | n+m+1 == sz  -> Just sz
-                            _                               -> Nothing
-
 {--------------------------------------------------------------------
   Utilities
 --------------------------------------------------------------------}