{-# OPTIONS_GHC -fglasgow-exts #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Map.AVL
-- Copyright   :  (c) Adrian Hey 2005,2006
-- License     :  BSD3
--
-- Maintainer  :  http://homepages.nildram.co.uk/~ahey/em.png
-- Stability   :  provisional
-- Portability :  portable
--
-- This module provides an AVL tree based clone of the base package Data.Map.
--
-- There are some differences though..
--
-- * 'size' is O(n), not O(1).
--
-- * The indexing operations are not supported as they are highly suspicious
--   and would in any case all be O(n) with AVL trees. If you need a some
--   kind of pointer to a particular position in a 'Map' then consider
--   using an 'OMap' or the Zipper functionality of the underlying AVL API
--   ('Data.Tree.AVL.ZAVL').
--
-- * The debugging functions showTree and showTreeWith are not implemented.
--
-- * This API has improved strictness control (strict variants of many functions
--   have been added).
--
-- * 'Read' and 'Show' instances use 'fromDistinctList', not 'fromList' (which this
--   module deprecates).
--
-- * No instances for Data, Traversable, and Arbitrary classes (yet).
--
-- * A few more goodies.
--
-- \"Biasing\" policy for keys is different. This will make no difference for
--  most users, but those using an instance of 'Ord' for which 'compare' may return
--  'EQ' for non-equal keys please read on.
--
--  The original 'Data.Map' module is apparently \"/Left Biased/\". Biasing policy in
--  this module depends on whether a function operates on one or two Maps.
--
-- * For functions operating on one Map, keys that are already present in the
--   Map are prefered over those supplied as arguments. This policy applies
--   to the keys used in associations and as an argument of any combining function.
--
-- * For functions operating on two Maps (such as union etc..), keys from the left most
--   Map are prefered. Again, this policy applies to the keys used in associations and as
--   an argument of any combining function.
--
-----------------------------------------------------------------------------
module Data.Map.AVL
(-- * Map type
 Map

 -- * Operators
 ,(!),(\\)

 -- * Query
 ,null,size,member,notMember,lookup,findWithDefault

 -- * Primitive Construction
 ,empty,singleton

 -- * Insertion
 -- | These operations may either insert new associations or modify existing ones.
 ,insert,insertWith,insertWithKey
 -- ** (Strict Insertion)
 ,insertWith',insertWithKey'
 ,insertWith'',insertWithKey''

 -- * Delete\/Update
 ,delete,alter
 ,adjust,adjustWithKey
 ,update,updateWithKey
 -- ** (Strict Delete\/Update)
 ,adjust',adjustWithKey'

 -- * Union
 ,union,unionWith,unionWithKey
 ,unionMaybe,unionMaybeKey
 -- ** (Strict Union)
 ,unionWith',unionWithKey'

 -- * Intersection
 ,intersection,intersectionWith,intersectionWithKey
 ,intersectionMaybe,intersectionMaybeKey
 ,restrict
 -- ** (Strict Intersection)
 ,intersectionWith',intersectionWithKey'

 -- * Difference
 ,difference
 ,differenceMaybe,differenceMaybeKey
 ,without

 -- * Map
 ,map,mapWithKey
 ,mapAccum,mapAccumWithKey
 ,mapKeysWith
 ,mapKeysOneToOne,mapKeysMonotonic
 -- ** (Strict Map)
 ,map',mapWithKey'
 ,mapAccum',mapAccumWithKey'
 ,mapKeysWith'
 ,mapKeysMonotonic'

 -- * Conventional Folds
 ,fold,foldWithKey
 -- ** (Strict conventional folds)
 ,fold',foldWithKey'

 -- * Unconventional Folds
 -- | These folds are \"unconventional\" in that they are all conceptually /right/
 -- folds on lists, with the order of lists being ascending or descending order of keys.
 --
 -- The argument order is different from usual too, with the initial accumulator as the /third/ argument.
 -- This helps when writing nested folds (on nested Maps of Maps of Maps.. for example).
 -- The type of a partially applied fold is suitable as the first argument of another fold.
 ,foldrElemsAsc,foldrElemsDesc
 ,foldrKeysAsc,foldrKeysDesc
 ,foldrAssocsAsc,foldrAssocsDesc
 -- ** (Strict unconventional folds)
 ,foldrElemsAsc',foldrElemsDesc'
 ,foldrKeysAsc',foldrKeysDesc'
 ,foldrAssocsAsc',foldrAssocsDesc'

 -- * Conversion to sorted Lists

 -- ** Ascending order
 ,assocsAsc,elemsAsc,keysAsc

 -- ** Descending order
 ,assocsDesc,elemsDesc,keysDesc

 -- * Conversion from sorted Lists

 -- ** Ascending order
 ,fromDistinctAscList,fromAscListWith,fromAscListWithKey
 -- *** (Strict Ascending order)
 ,fromAscListWith',fromAscListWithKey'

 -- ** Descending order
 ,fromDistinctDescList,fromDescListWith,fromDescListWithKey

 -- *** (Strict Descending order)
 ,fromDescListWith',fromDescListWithKey'

 -- * Conversion from unsorted Lists
 ,fromDistinctList,fromListWith,fromListWithKey

 -- ** (Strict Conversion from unsorted Lists)
 ,fromListWith',fromListWithKey'

 -- * Other conversions
 ,keysSet,liftKeysSet,unsafeFromTree,toTree

 -- ** (Strict Other conversions)
 ,liftKeysSet'

 -- * Filter
 ,filter,filterWithKey
 ,partition,partitionWithKey
 ,split,splitLookup
 ,mapMaybe,mapMaybeKey
-- , mapEither,mapEitherWithKey TODO

 -- * Submap
 ,isSubmapOf
 ,isSubmapOfBy
 ,isProperSubmapOf,isProperSubmapOfBy

 -- * Min\/Max
 ,findMin,findMax
 ,deleteMin,deleteMax
 ,deleteFindMin,deleteFindMax
 ,updateMin,updateMax
 ,updateMinWithKey,updateMaxWithKey
 ,minView,maxView
 ,minViewWithKey,maxViewWithKey

 -- * OMap operations.
 -- | These are intended to provide you with a simple way to implement whichever of
 -- multitude of possible hybrid lookup\/adjust\/insert\/delete operations you actually
 -- require yourself.
 ,OMap
 ,openMap,readOMap,readAssocOMap,readKeyOMap,deleteOMap,writeOMap,writeNewKeyOMap,closeOMap

 -- * Debugging
 ,valid

 -- * Deprecated
 ,unions,unionsWith
 ,differenceWith,differenceWithKey
 ,assocs,elems,keys
 ,toList,toAscList
 ,fromList,fromAscList
 ,mapKeys
 ,insertLookupWithKey,updateLookupWithKey
 ,readOMapKey
) where

{- TODO:
Improve efficiency of Intersection operations (in AVL and hence here too)

Add Instances of: Data,Traversable,Arbitrary

Fix Naming anomolies and inconsistencies, such as:
        update <-> updateWithKey
        lookup <-> findWithDefault
        partition <-> partitionWithKey
        filter <-> filterWithKey
        updateMin <-> updateMinWithKey
        updateMax <-> updateMaxWithKey

Implement mapEither,mapEitherWithKey
-}

import Prelude hiding (lookup,map,filter,foldr,foldl,null)
import qualified Data.List as L
import Data.Typeable
import qualified Data.Monoid as M (Monoid(..))
import qualified Data.Foldable as F (Foldable(..))

#if __GLASGOW_HASKELL__
import qualified Text.Read as R (Read(..),Lexeme(..),parens,prec,lexP,readListPrecDefault)
-- import Data.Generics.Basics
-- import Data.Generics.Instances
#endif

import qualified Data.Set.AVL as Set
import qualified Data.COrdering as COrdering
import qualified Data.Tree.AVL as AVL

#include "Typeable.h"
INSTANCE_TYPEABLE2(Map,mapTc,"Data.Map.AVL")

-------------------------------------------------------
----                Map type                       ----
-------------------------------------------------------
-- | A Map from keys @k@ to values @a@.
newtype Map k a = Map (AVL.AVL (k, a))

-------------------------------------------------------
----                Operators                      ----
-------------------------------------------------------
infixl 9 !, \\ --

-- | /O(log n)/. Find the value at a key.
-- Calls 'error' when the element can not be found.
(!) :: Ord k => Map k a -> k -> a
(!) m k = findWithDefault (error "Map.(!): element not in the map") k m
{-# INLINE (!) #-}

-- | /O(n+m)/. See 'difference'.
(\\) :: Ord k => Map k a -> Map k b -> Map k a
m1 \\ m2 = difference m1 m2
{-# INLINE (\\) #-}

-------------------------------------------------------
----                 Query                         ----
-------------------------------------------------------
-- | /O(1)/. Is the map empty?
null :: Map k a -> Bool
null (Map t) = AVL.isEmpty t
{-# INLINE null #-}

-- | /O(n)/. The number of elements in the map.
size :: Map k a -> Int
size (Map t) = AVL.size t
{-# INLINE size #-}

-- | /O(log n)/. Is the key a member of the map?
member :: Ord k => k -> Map k a -> Bool
member k (Map t) = AVL.genContains t cmp
 where cmp (k',_) = compare k k'

-- | /O(log n)/. Is the key not a member of the map?
notMember :: Ord k => k -> Map k a -> Bool
notMember k m = not (member k m)
{-# INLINE notMember #-}

-- | /O(log n)/. Lookup the value at a key in the map.
lookup :: (Monad m,Ord k) => k -> Map k a -> m a
lookup k (Map t) = maybe (fail "AvlMap.lookup: Key not found") return (AVL.genTryRead t (readValCC k))
{-# SPECIALIZE lookup :: Ord k => k -> Map k a -> Maybe a #-}

-- | /O(log n)/. The expression @('findWithDefault' def k map)@ returns
-- the value at key @k@ or returns @def@ when the key is not in the map.
findWithDefault :: Ord k => a -> k -> Map k a -> a
findWithDefault def k (Map t) = AVL.genDefaultRead def t (readValCC k)
{-# INLINE findWithDefault #-}

-------------------------------------------------------
----              Construction                     ----
-------------------------------------------------------
-- | /O(1)/. The empty map.
empty :: Map k a
empty = Map (AVL.empty)

-- | /O(1)/. A map with a single element.
singleton :: k -> a -> Map k a
singleton k a = Map (AVL.singleton (k, a))
{-# INLINE singleton #-}

-------------------------------------------------------
----               Insertion                       ----
-------------------------------------------------------
-- | /O(log n)/. Insert a new key and value in the map.
-- If the key is already present in the map, the associated value is
-- replaced with the supplied value.
insert :: Ord k => k -> a -> Map k a -> Map k a
insert k a (Map t) = Map (AVL.genPush cmp (k,a) t)
 where cmp (k', _) = case compare k k' of
                     LT -> COrdering.Lt
                     EQ -> COrdering.Eq (k',a)
                     GT -> COrdering.Gt

-- | /O(log n)/. Insert with a combining function.
-- If the combining function is applied, the first argument is the new associated value
-- and the second is the associated value already present in the Map.
insertWith :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
insertWith f k a (Map t) = Map (AVL.genPush cmp (k,a) t)
 where cmp (k', a') = case compare k k' of
                      LT -> COrdering.Lt
                      EQ -> COrdering.Eq (k', f a a')  -- Note Argument order!!
                      GT -> COrdering.Gt

-- | /O(log n)/. Insert with a combining function that includes the key.
-- If the combining function is applied, the second argument is the new associated value
-- and the third is the associated value already present in the Map.
insertWithKey :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
insertWithKey f k a (Map t) = Map (AVL.genPush cmp (k,a) t)
 where cmp (k', a') = case compare k k' of
                      LT -> COrdering.Lt
                      EQ -> COrdering.Eq (k', f k' a a') -- Note Argument order!!
                      GT -> COrdering.Gt


-------------------------------------------------------
----             Strict Insertion                  ----
-------------------------------------------------------

-- | Same as 'insertWith', but the combining function is applied strictly.
insertWith' :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
insertWith' f k a (Map t) = Map (AVL.genPush cmp (k,a) t)
 where cmp (k', a') = case compare k k' of
                      LT -> COrdering.Lt
                      EQ -> let a'' = f a a'  -- Note Argument order!!
                            in a'' `seq` COrdering.Eq (k',a'')
                      GT -> COrdering.Gt

-- | Same as 'insertWithKey', but the combining function is applied strictly.
insertWithKey' :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
insertWithKey' f k a (Map t) = Map (AVL.genPush cmp (k,a) t)
 where cmp (k', a') = case compare k k' of
                      LT -> COrdering.Lt
                      EQ -> let a'' = f k' a a'  -- Note Argument order!!
                            in a'' `seq` COrdering.Eq (k',a'')
                      GT -> COrdering.Gt

-- | Same as 'insertWith'', but this version also forces evaluation of the
-- newly inserted value (third argument), but /only/ if it is inserted in the
-- Map as a new association (I.E. if the key is not found).
insertWith'' :: Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
insertWith'' f k a (Map t) = Map (AVL.genPush' cmp (a `seq` (k,a)) t)
 where cmp (k', a') = case compare k k' of
                      LT -> COrdering.Lt
                      EQ -> let a'' = f a a'  -- Note Argument order!!
                            in a'' `seq` COrdering.Eq (k',a'')
                      GT -> COrdering.Gt

-- | Same as 'insertWithKey'', but this version also forces evaluation of the
-- newly inserted value (third argument), but /only/ if it is inserted in the
-- Map as a new association (I.E. if the key is not found).
insertWithKey'' :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
insertWithKey'' f k a (Map t) = Map (AVL.genPush' cmp (a `seq` (k,a)) t)
 where cmp (k', a') = case compare k k' of
                      LT -> COrdering.Lt
                      EQ -> let a'' = f k' a a'  -- Note Argument order!!
                            in a'' `seq` COrdering.Eq (k',a'')
                      GT -> COrdering.Gt

-------------------------------------------------------
----                Delete/Update                  ----
-------------------------------------------------------
-- | /O(log n)/. Delete a key and its value from the map. When the key is not
-- a member of the map, the original map is returned.
delete :: Ord k => k -> Map k a -> Map k a
delete k (Map t) = Map (AVL.genDel cmp t)
 where cmp (k', _) = compare k k'

-- | /O(log n)/. The expression (@'alter' f k map@) alters the value @x@ at @k@, or absence thereof.
-- 'alter' can be used to insert, delete, or update a value in a 'Map'.
-- In short : @'lookup' k ('alter' f k m) = f ('lookup' k m)@
alter :: Ord k => (Maybe a -> Maybe a) -> k -> Map k a -> Map k a
alter f k (Map t) = case AVL.tryReadBAVL bavl of
                    Nothing     -> Map (doIt k  Nothing ) -- bavl is empty
                    Just (k',a) -> Map (doIt k' (Just a)) -- bavl is full
 where bavl = AVL.genOpenBAVL cmp t
       cmp (k',_) = compare k k'
       doIt k' mba = case f mba of
                     Nothing -> AVL.deleteBAVL bavl       -- This is a nop for empty bavl
                     Just a' -> AVL.pushBAVL (k',a') bavl -- This is a write for full bavl


-- | /O(log n)/. Adjust a value at a specific key. When the key is not
-- a member of the map, the original map is returned.
adjust :: Ord k => (a -> a) -> k -> Map k a -> Map k a
adjust f k (Map t) = Map (AVL.genWrite cmp t)
 where cmp (k',a) = case compare k k' of
                    LT -> COrdering.Lt
                    EQ -> COrdering.Eq (k', f a)
                    GT -> COrdering.Gt


-- | /O(log n)/. Adjust a value at a specific key. When the key is not
-- a member of the map, the original map is returned.
adjustWithKey :: Ord k => (k -> a -> a) -> k -> Map k a -> Map k a
adjustWithKey f k (Map t) = Map (AVL.genWrite cmp t)
 where cmp (k',a) = case compare k k' of
                    LT -> COrdering.Lt
                    EQ -> COrdering.Eq (k', f k' a)
                    GT -> COrdering.Gt

-- | /O(log n)/. The expression (@'update' f k map@) updates the value @x@
-- at @k@ (if it is in the map). If (@f x@) is 'Nothing', the element is
-- deleted. If it is (@'Just' y@), the key @k@ is bound to the new value @y@.
update :: Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
update f k (Map t) = Map (AVL.genDelMaybe cmp t)
 where cmp (k',a) = case compare k k' of
                    LT -> COrdering.Lt
                    EQ -> case f a of
                          Nothing -> COrdering.Eq Nothing
                          Just a' -> COrdering.Eq (Just (k',a'))
                    GT -> COrdering.Gt

-- | /O(log n)/. The expression (@'updateWithKey' f k map@) updates the
-- value @x@ at @k@ (if it is in the map). If (@f k x@) is 'Nothing',
-- the element is deleted. If it is (@'Just' y@), the key @k@ is bound
-- to the new value @y@.
updateWithKey :: Ord k => (k -> a -> Maybe a) -> k -> Map k a -> Map k a
updateWithKey f k (Map t) = Map (AVL.genDelMaybe cmp t)
 where cmp (k',a) = case compare k k' of
                    LT -> COrdering.Lt
                    EQ -> case f k' a of
                          Nothing -> COrdering.Eq Nothing
                          Just a' -> COrdering.Eq (Just (k',a'))
                    GT -> COrdering.Gt

-------------------------------------------------------
----              Strict Update                    ----
-------------------------------------------------------
-- | /O(log n)/. This version of 'adjust' applies the combining function strictly.
adjust' :: Ord k => (a -> a) -> k -> Map k a -> Map k a
adjust' f k (Map t) = Map (AVL.genWrite cmp t)
 where cmp (k',a) = case compare k k' of
                    LT -> COrdering.Lt
                    EQ -> let a' = f a in a' `seq` COrdering.Eq (k',a')
                    GT -> COrdering.Gt


-- | /O(log n)/. This version of 'adjustWithKey' applies the combining function strictly.
adjustWithKey' :: Ord k => (k -> a -> a) -> k -> Map k a -> Map k a
adjustWithKey' f k (Map t) = Map (AVL.genWrite cmp t)
 where cmp (k',a) = case compare k k' of
                    LT -> COrdering.Lt
                    EQ -> let a' = f k' a in a' `seq` COrdering.Eq (k',a')
                    GT -> COrdering.Gt

-------------------------------------------------------
----                  Union                        ----
-------------------------------------------------------
-- | /O(n+m)/.
-- The expression (@'union' t1 t2@) takes the left-biased union of @t1@ and @t2@.
-- It prefers @t1@ when duplicate keys are encountered.
union :: Ord k => Map k a -> Map k a -> Map k a
union (Map t1) (Map t2) = Map (AVL.genUnion cmp t1 t2)
 where cmp left@(k,_) (k',_) = case compare k k' of
                               LT -> COrdering.Lt
                               EQ -> COrdering.Eq left
                               GT -> COrdering.Gt


-- | /O(n+m)/. Union with a combining function. If the combining function is applied
-- the first value argument is taken from the first map and the second value argument
-- is taken from from the second map.
unionWith :: Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
unionWith f (Map t1) (Map t2) = Map (AVL.genUnion cmp t1 t2)
 where cmp (k,a) (k',a') = case compare k k' of
                           LT -> COrdering.Lt
                           EQ -> COrdering.Eq (k, f a a')
                           GT -> COrdering.Gt

-- | /O(n+m)/. Union with a combining function.  If the combining function is applied
-- the key and first value arguments are taken from the first map and the second value argument
-- is taken from from the second map.
unionWithKey :: Ord k => (k -> a -> a -> a) -> Map k a -> Map k a -> Map k a
unionWithKey f (Map t1) (Map t2) = Map (AVL.genUnion cmp t1 t2)
 where cmp (k,a) (k',a') = case compare k k' of
                           LT -> COrdering.Lt
                           EQ -> COrdering.Eq (k, f k a a')
                           GT -> COrdering.Gt


-- | /O(n+m)/. Union with a combining function that may return Nothing.
-- If it does the corresponding association is deleted from the result.
-- If the combining function is applied the first value argument is taken from
-- the first map and the second value argument is taken from from the second map.
unionMaybe :: Ord k => (a -> a -> Maybe a) -> Map k a -> Map k a -> Map k a
unionMaybe f (Map t1) (Map t2) = Map (AVL.genUnionMaybe cmp t1 t2)
 where cmp (k,a) (k',a') = case compare k k' of
                           LT -> COrdering.Lt
                           EQ -> case f a a' of
                                 Nothing  -> COrdering.Eq Nothing
                                 Just a'' -> COrdering.Eq (Just (k, a''))
                           GT -> COrdering.Gt

-- | /O(n+m)/. Union with a combining function that may return Nothing.
-- If it does the corresponding association is deleted from the result.
-- If the combining function is applied the first value argument is taken from
-- the first map and the second value argument is taken from from the second map.
unionMaybeKey :: Ord k => (k -> a -> a -> Maybe a) -> Map k a -> Map k a -> Map k a
unionMaybeKey f (Map t1) (Map t2) = Map (AVL.genUnionMaybe cmp t1 t2)
 where cmp (k,a) (k',a') = case compare k k' of
                           LT -> COrdering.Lt
                           EQ -> case f k a a' of
                                 Nothing  -> COrdering.Eq Nothing
                                 Just a'' -> COrdering.Eq (Just (k, a''))
                           GT -> COrdering.Gt

-------------------------------------------------------
----                Strict Union                   ----
-------------------------------------------------------
-- | /O(n+m)/. This version of 'unionWith' applies the combining function strictly.
unionWith' :: Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
unionWith' f (Map t1) (Map t2) = Map (AVL.genUnion cmp t1 t2)
 where cmp (k,a) (k',a') = case compare k k' of
                           LT -> COrdering.Lt
                           EQ -> let a'' = f a a' in a'' `seq` COrdering.Eq (k, a'')
                           GT -> COrdering.Gt

-- | /O(n+m)/. This version of 'unionWithKey' applies the combining function strictly.
unionWithKey' :: Ord k => (k -> a -> a -> a) -> Map k a -> Map k a -> Map k a
unionWithKey' f (Map t1) (Map t2) = Map (AVL.genUnion cmp t1 t2)
 where cmp (k,a) (k',a') = case compare k k' of
                           LT -> COrdering.Lt
                           EQ -> let a'' = f k a a' in a'' `seq` COrdering.Eq (k, a'')
                           GT -> COrdering.Gt

-------------------------------------------------------
----              Intersection                     ----
-------------------------------------------------------
-- | /O(n+m)/. Intersection of two maps. For equal keys, the values in the first
-- map are returned.
intersection :: Ord k => Map k a -> Map k b -> Map k a
intersection (Map t1) (Map t2) = Map (AVL.genIntersection cmp t1 t2)
 where cmp assoc@(k,_) (k',_) = case compare k k' of
                                LT -> COrdering.Lt
                                EQ -> COrdering.Eq assoc
                                GT -> COrdering.Gt

-- | /O(n+m)/. Intersection with a combining function. If the combining function is applied
-- the first value argument is taken from the first map and the second value argument
-- is taken from from the second map.
intersectionWith :: Ord k => (a -> b -> c) -> Map k a -> Map k b -> Map k c
intersectionWith f (Map t1) (Map t2) = Map (AVL.genIntersection cmp t1 t2)
 where cmp (k,a) (k',b) = case compare k k' of
                          LT -> COrdering.Lt
                          EQ -> COrdering.Eq (k, f a b)
                          GT -> COrdering.Gt

-- | /O(n+m)/. Intersection with a combining function. If the combining function is applied
-- the first value argument is taken from the first map and the second value argument
-- is taken from from the second map.
intersectionWithKey :: Ord k => (k -> a -> b -> c) -> Map k a -> Map k b -> Map k c
intersectionWithKey f (Map t1) (Map t2) = Map (AVL.genIntersection cmp t1 t2)
 where cmp (k,a) (k',b) = case compare k k' of
                          LT -> COrdering.Lt
                          EQ -> COrdering.Eq (k, f k a b)
                          GT -> COrdering.Gt

-- | /O(n+m)/. Similar to 'intersectionWith', but the resulting map does not
-- include elements in cases where the supplied combining comparison returns @(Eq Nothing)@.
intersectionMaybe :: Ord k => (a -> b -> Maybe c) -> Map k a -> Map k b -> Map k c
intersectionMaybe f (Map t1) (Map t2) = Map (AVL.genIntersectionMaybe cmp t1 t2)
 where cmp (k,a) (k',b) = case compare k k' of
                          LT -> COrdering.Lt
                          EQ -> case f a b of
                                Nothing -> COrdering.Eq Nothing
                                Just c  -> COrdering.Eq (Just (k,c))
                          GT -> COrdering.Gt

-- | /O(n+m)/. Similar to 'intersectionWithKey', but the resulting map does not
-- include elements in cases where the supplied combining comparison returns @(Eq Nothing)@.
intersectionMaybeKey :: Ord k => (k -> a -> b -> Maybe c) -> Map k a -> Map k b -> Map k c
intersectionMaybeKey f (Map t1) (Map t2) = Map (AVL.genIntersectionMaybe cmp t1 t2)
 where cmp (k,a) (k',b) = case compare k k' of
                          LT -> COrdering.Lt
                          EQ -> case f k a b of
                                Nothing -> COrdering.Eq Nothing
                                Just c  -> COrdering.Eq (Just (k,c))
                          GT -> COrdering.Gt

-- | /O(n+m)/. Intersection of a 'Map' and a 'Data.Set.AVL.Set'.
-- Associations whose keys are not members of the Set are deleted from the Map.
restrict :: Ord k => Map k a -> Set.Set k -> Map k a
restrict (Map tm) set = Map (AVL.genIntersection cmp tm (Set.toTree set))
 where cmp assoc@(k,_) k' = case compare k k' of
                            LT -> COrdering.Lt
                            EQ -> COrdering.Eq assoc
                            GT -> COrdering.Gt

-------------------------------------------------------
----            Strict Intersection                ----
-------------------------------------------------------
-- | /O(n+m)/. This version of 'intersectionWith' applies the combining function strictly.
intersectionWith' :: Ord k => (a -> b -> c) -> Map k a -> Map k b -> Map k c
intersectionWith' f (Map t1) (Map t2) = Map (AVL.genIntersection cmp t1 t2)
 where cmp (k,a) (k',b) = case compare k k' of
                          LT -> COrdering.Lt
                          EQ -> let c = f a b in c `seq` COrdering.Eq (k, c)
                          GT -> COrdering.Gt

-- | /O(n+m)/. This version of 'intersectionWithKey' applies the combining function strictly.
intersectionWithKey' :: Ord k => (k -> a -> b -> c) -> Map k a -> Map k b -> Map k c
intersectionWithKey' f (Map t1) (Map t2) = Map (AVL.genIntersection cmp t1 t2)
 where cmp (k,a) (k',b) = case compare k k' of
                          LT -> COrdering.Lt
                          EQ -> let c = f k a b in c `seq` COrdering.Eq (k, c)
                          GT -> COrdering.Gt

-------------------------------------------------------
----               Difference                      ----
-------------------------------------------------------
-- | /O(n+m)/. Difference of two maps.
difference :: Ord k => Map k a -> Map k b -> Map k a
difference (Map t1) (Map t2) = Map (AVL.genDifference cmp t1 t2)
 where cmp (k,_) (k',_) = compare k k'

-- | /O(n+m)/. Difference with a combining function. If the combining function returns
-- @Just a@ then the corresponding association is not deleted from the result 'Map'
-- (it is retained with @a@ as the associated value).
differenceMaybe :: Ord k => (a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a
differenceMaybe f (Map ta) (Map tb) = Map (AVL.genDifferenceMaybe cmp ta tb)
 where cmp (k,a) (k',b) = case compare k k' of
                          LT -> COrdering.Lt
                          EQ -> case f a b of
                                Nothing -> COrdering.Eq Nothing
                                Just a' -> COrdering.Eq (Just (k,a'))
                          GT -> COrdering.Gt

-- | /O(n+m)/. Same as differenceWith, but the key is also an argument of the combining function.
differenceMaybeKey :: Ord k => (k -> a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a
differenceMaybeKey f (Map ta) (Map tb) = Map (AVL.genDifferenceMaybe cmp ta tb)
 where cmp (k,a) (k',b) = case compare k k' of
                          LT -> COrdering.Lt
                          EQ -> case f k a b of
                                Nothing -> COrdering.Eq Nothing
                                Just a' -> COrdering.Eq (Just (k,a'))
                          GT -> COrdering.Gt

-- | /O(n+m)/. Difference between a 'Map' and a 'Data.Set.AVL.Set'.
-- Associations with keys that are members of the Set are deleted from the Map.
without :: Ord k => Map k a -> Set.Set k -> Map k a
without (Map tm) set = Map (AVL.genDifference cmp tm (Set.toTree set))
 where cmp (k,_) k' = compare k k'

-------------------------------------------------------
----                   Map                         ----
-------------------------------------------------------
-- | /O(n)/. Map a function over all values in the map.
map :: (a -> b) -> Map k a -> Map k b
-- Note use of strict AVL map! (This does not force evaluation of f a).
map f (Map t) = Map (AVL.mapAVL' (\(k,a) -> (k, f a)) t)
{-# INLINE map #-}

-- | /O(n*log n)/.
-- @'mapKeysWith' c f s@ is the map obtained by applying @f@ to each key of @s@.
--
-- The input map is processed in ascending order of keys.
--
-- The size of the result may be smaller if @f@ maps two or more distinct
-- keys to the same new key.  In this case the associated values will be
-- combined using @c@, with the new value as the first argument of c.
-- The net result of this is the same as applying @('foldr1' c)@
-- to the list of original values in /descending/ order of (original) keys.
mapKeysWith :: Ord k2 => (a -> a -> a) -> (k1->k2) -> Map k1 a -> Map k2 a
mapKeysWith c f (Map tk1) = Map (L.foldl' addAssoc AVL.empty (mapf (AVL.asListL tk1)))
 where mapf []             = []
       mapf ((k1,a):pairs) = let k2 = f k1 in k2 `seq` (k2,a):(mapf pairs)
       addAssoc tk2 assoc@(k2,a) = AVL.genPush cmp assoc tk2
        where cmp (k2',a') = case compare k2 k2' of
                             LT -> COrdering.Lt
                             EQ -> COrdering.Eq (k2', c a a') -- c new old!
                             GT -> COrdering.Gt

-- | /O(n*log n)/.
-- @'mapKeysOneToOne' f s@ is the map obtained by applying @f@ to each key of @s@.
--
-- The supplied function should be \"one to one\". That is, no two distinct input keys
-- should yield the same output key. This function raises an error if the same
-- key occurs twice in the resulting key set.
mapKeysOneToOne :: Ord k2 => (k1->k2) -> Map k1 a -> Map k2 a
mapKeysOneToOne f (Map tk1) = Map (L.foldl' addAssoc AVL.empty (mapf (AVL.asListL tk1)))
 where mapf []             = []
       mapf ((k1,a):pairs) = let k2 = f k1 in k2 `seq` (k2,a):(mapf pairs)
       addAssoc tk2 assoc@(k2,_) = AVL.genPushMaybe cmp assoc tk2
        where cmp (k2',_) = case compare k2 k2' of
                            LT -> COrdering.Lt
                            EQ -> error "Map.mapKeysOneToOne: Duplicate keys found."
                            GT -> COrdering.Gt

-- | /O(n)/.
-- @'mapKeysMonotonic' f s == 'mapKeys' f s@, but works only when @f@
-- is strictly monotonic.
-- /The precondition is not checked./
-- Semi-formally, we have:
--
-- > and [x < y ==> f x < f y | x <- ls, y <- ls]
-- >                     ==> mapKeysMonotonic f s == mapKeys f s
-- >     where ls = keys s
mapKeysMonotonic :: (k1->k2) -> Map k1 a -> Map k2 a
-- Note use of strict AVL map! (This does not force evaluation of f k).
mapKeysMonotonic f (Map t) = Map (AVL.mapAVL' (\(k,a) -> (f k, a)) t)
{-# INLINE mapKeysMonotonic #-}

-- | /O(n)/. Map a function over all values in the map.
mapWithKey :: (k -> a -> b) -> Map k a -> Map k b
-- Note use of strict AVL map! (This does not force evaluation of f k a).
mapWithKey f (Map t) = Map (AVL.mapAVL' (\(k,a) -> (k, f k a)) t)
{-# INLINE mapWithKey #-}

-- | /O(n)/. The function 'mapAccum' threads an accumulating
-- argument through the map in ascending order of keys.
mapAccum :: Ord k => (a -> b -> (a, c)) -> a -> Map k b -> (a, Map k c)
-- Note use of strict AVL mapAccumL! (This does not force evaluation of f a b).
#ifdef __GLASGOW_HASKELL__
mapAccum f a (Map tb) = case AVL.mapAccumLAVL'' f' a tb of (a',tc) -> (a',Map tc)
 where f' z (k,b) = let (z',c) = f z b in (# z',(k,c) #)
#else
mapAccum f a (Map tb) = case AVL.mapAccumLAVL' f' a tb of (a',tc) -> (a',Map tc)
 where f' z (k,b) = let (z',c) = f z b in (z',(k,c))
#endif

-- | /O(n)/. Similar to 'mapAccum', but the supplied function also takes the
-- current key as an argument.
mapAccumWithKey :: Ord k => (a -> k -> b -> (a, c)) -> a -> Map k b -> (a, Map k c)
-- Note use of strict AVL mapAccumL! (This does not force evaluation of f a k b).
#ifdef __GLASGOW_HASKELL__
mapAccumWithKey f a (Map tb) = case AVL.mapAccumLAVL'' f' a tb of (a',tc) -> (a',Map tc)
 where f' z (k,b) = let (z',c) = f z k b in (# z',(k,c) #)
#else
mapAccumWithKey f a (Map tb) = case AVL.mapAccumLAVL' f' a tb of (a',tc) -> (a',Map tc)
 where f' z (k,b) = let (z',c) = f z k b in (z',(k,c))
#endif

-------------------------------------------------------
----                Strict Map                     ----
-------------------------------------------------------
-- | /O(n)/. Same as 'map', but the function is applied strictly.
map' :: (a -> b) -> Map k a -> Map k b
map' f (Map t) = Map (AVL.mapAVL' (\(k,a) -> let b = f a in b `seq` (k, b)) t)
{-# INLINE map' #-}

-- | /O(n*log n)/.
-- This is the strict version of 'mapKeysWith'. (The associated value combining
-- function @c@ is applied strictly.)
mapKeysWith' :: Ord k2 => (a -> a -> a) -> (k1->k2) -> Map k1 a -> Map k2 a
mapKeysWith' c f (Map tk1) = Map (L.foldl' addAssoc AVL.empty (mapf (AVL.asListL tk1)))
 where mapf []             = []
       mapf ((k1,a):pairs) = let k2 = f k1 in k2 `seq` (k2,a):(mapf pairs)
       addAssoc tk2 assoc@(k2,a) = AVL.genPush cmp assoc tk2
        where cmp (k2',a') = case compare k2 k2' of
                             LT -> COrdering.Lt
                             EQ -> let a'' = c a' a in a'' `seq` COrdering.Eq (k2', a'') -- c old new!
                             GT -> COrdering.Gt

-- | /O(n)/. Same as 'mapKeysMonotonic', but the function is applied strictly.
mapKeysMonotonic' :: (k1->k2) -> Map k1 a -> Map k2 a
mapKeysMonotonic' f (Map t) = Map (AVL.mapAVL' (\(k,a) -> let k' = f k in k' `seq` (k', a)) t)
{-# INLINE mapKeysMonotonic' #-}

-- | /O(n)/. Same as 'mapWithKey', but function is applied strictly.
mapWithKey' :: (k -> a -> b) -> Map k a -> Map k b
mapWithKey' f (Map t) = Map (AVL.mapAVL' (\(k,a) -> let b = f k a in b `seq` (k, b)) t)
{-# INLINE mapWithKey' #-}

-- | /O(n)/. This is the strict version of 'mapAccum'.
mapAccum' :: Ord k => (a -> b -> (a, c)) -> a -> Map k b -> (a, Map k c)
#ifdef __GLASGOW_HASKELL__
mapAccum' f a (Map tb) = case AVL.mapAccumLAVL'' f' a tb of (a',tc) -> (a',Map tc)
 where f' z (k,b) = case f z b of (z',c) -> (# z',(k,c) #)
#else
mapAccum' f a (Map tb) = case AVL.mapAccumLAVL' f' a tb of (a',tc) -> (a',Map tc)
 where f' z (k,b) = case f z b of (z',c) -> (z',(k,c))
#endif

-- | /O(n)/. This is the strict version of 'mapAccumWithKey'.
mapAccumWithKey' :: Ord k => (a -> k -> b -> (a, c)) -> a -> Map k b -> (a, Map k c)
#ifdef __GLASGOW_HASKELL__
mapAccumWithKey' f a (Map tb) = case AVL.mapAccumLAVL'' f' a tb of (a',tc) -> (a',Map tc)
 where f' z (k,b) = case f z k b of (z',c) -> (# z',(k,c) #)
#else
mapAccumWithKey' f a (Map tb) = case AVL.mapAccumLAVL' f' a tb of (a',tc) -> (a',Map tc)
 where f' z (k,b) = case f z k b of (z',c) -> (z',(k,c))
#endif

-------------------------------------------------------
----           Conventional Folds                  ----
-------------------------------------------------------
-- | /O(n)/. Fold the values in the map, such that
-- @'fold' f z == 'Prelude.foldr' f z . 'elems'@.
-- For example,
--
-- > elems map = fold (:) [] map
--
fold :: (a -> b -> b) -> b -> Map k a -> b
fold f b0 (Map t) = AVL.foldrAVL (\(_, a) b  -> f a b) b0 t  -- Non-strict right fold!!
{-# INLINE fold #-}

-- | /O(n)/. Fold the keys and values in the map, such that
-- @'foldWithKey' f z == 'Prelude.foldr' ('uncurry' f) z . 'toAscList'@.
-- For example,
--
-- > keys map = foldWithKey (\k x ks -> k:ks) [] map
--
foldWithKey :: (k -> a -> b -> b) -> b -> Map k a -> b
foldWithKey f b0 (Map t) = AVL.foldrAVL (\(k, a) b  -> f k a b) b0 t -- Non-strict right fold!!
{-# INLINE foldWithKey #-}

-------------------------------------------------------
----          Strict Conventional Folds            ----
-------------------------------------------------------

-- | /O(n)/. The strict version of 'fold'. You should consider using this with functions
-- that are strict in their second (I.E. accumulating) argument in order to avoid deep
-- recursion and possible stack overflow.
fold' :: (a -> b -> b) -> b -> Map k a -> b
fold' f b0 (Map t) = AVL.foldrAVL' (\(_, a) b  -> f a b) b0 t  -- Strict right fold!!
{-# INLINE fold' #-}

-- | /O(n)/. The strict version of 'foldWithKey'. You should consider using this with functions
-- that are strict in their third (I.E. accumulating) argument in order to avoid deep
-- recursion and possible stack overflow.
foldWithKey' :: (k -> a -> b -> b) -> b -> Map k a -> b
foldWithKey' f b0 (Map t) = AVL.foldrAVL' (\(k, a) b  -> f k a b) b0 t -- Strict right fold!!
{-# INLINE foldWithKey' #-}

-------------------------------------------------------
----         Unconventional Folds                  ----
-------------------------------------------------------
-- | Fold right over the list of elements in ascending order of keys.
foldrElemsAsc :: (a -> b -> b) -> Map k a -> b -> b
foldrElemsAsc f (Map t) b0 = AVL.foldrAVL (\(_,a) b -> f a b) b0 t  -- Non-strict right fold!!
{-# INLINE foldrElemsAsc #-}

-- | Fold right over the list of elements in descending order of keys.
foldrElemsDesc :: (a -> b -> b) -> Map k a -> b -> b
foldrElemsDesc f (Map t) b0 = AVL.foldlAVL (\b (_,a) -> f a b) b0 t  -- Non-strict left fold!!
{-# INLINE foldrElemsDesc #-}

-- | Fold right over the list of keys in ascending order.
foldrKeysAsc :: (k -> b -> b) -> Map k a -> b -> b
foldrKeysAsc f (Map t) b0 = AVL.foldrAVL (\(k,_) b -> f k b) b0 t  -- Non-strict right fold!!
{-# INLINE foldrKeysAsc #-}

-- | Fold right over the list of keys in descending order.
foldrKeysDesc :: (k -> b -> b) -> Map k a -> b -> b
foldrKeysDesc f (Map t) b0 = AVL.foldlAVL (\b (k,_) -> f k b) b0 t -- Non-strict left fold!!
{-# INLINE foldrKeysDesc #-}

-- | Fold right over the list of associations in ascending order of keys.
foldrAssocsAsc :: (k -> a -> b -> b) -> Map k a -> b -> b
foldrAssocsAsc f (Map t) b0 = AVL.foldrAVL (\(k,a) b -> f k a b) b0 t   -- Non-strict right fold!!
{-# INLINE foldrAssocsAsc #-}

-- | Fold right over the list of associations in descending order of keys.
foldrAssocsDesc :: (k -> a -> b -> b) -> Map k a -> b -> b
foldrAssocsDesc f (Map t) b0 = AVL.foldlAVL (\b (k,a) -> f k a b) b0 t  -- Non-strict left fold!!
{-# INLINE foldrAssocsDesc #-}

-------------------------------------------------------
----      Strict unconventional Folds              ----
-------------------------------------------------------
-- | This is the strict version of 'foldrElemsAsc' .
foldrElemsAsc' :: (a -> b -> b) -> Map k a -> b -> b
foldrElemsAsc' f (Map t) b0 = AVL.foldrAVL' (\(_,a) b -> f a b) b0 t  -- Strict right fold!!
{-# INLINE foldrElemsAsc' #-}

-- | This is the strict version of 'foldrElemsDesc' .
foldrElemsDesc' :: (a -> b -> b) -> Map k a -> b -> b
foldrElemsDesc' f (Map t) b0 = AVL.foldlAVL' (\b (_,a) -> f a b) b0 t  -- Strict left fold!!
{-# INLINE foldrElemsDesc' #-}

-- | This is the strict version of 'foldrKeysAsc' .
foldrKeysAsc' :: (k -> b -> b) -> Map k a -> b -> b
foldrKeysAsc' f (Map t) b0 = AVL.foldrAVL' (\(k,_) b -> f k b) b0 t  -- Strict right fold!!
{-# INLINE foldrKeysAsc' #-}

-- | This is the strict version of 'foldrKeysDesc' .
foldrKeysDesc' :: (k -> b -> b) -> Map k a -> b -> b
foldrKeysDesc' f (Map t) b0 = AVL.foldlAVL' (\b (k,_) -> f k b) b0 t -- Strict left fold!!
{-# INLINE foldrKeysDesc' #-}

-- | This is the strict version of 'foldrAssocsAsc' .
foldrAssocsAsc' :: (k -> a -> b -> b) -> Map k a -> b -> b
foldrAssocsAsc' f (Map t) b0 = AVL.foldrAVL' (\(k,a) b -> f k a b) b0 t   -- Strict right fold!!
{-# INLINE foldrAssocsAsc' #-}

-- | This is the strict version of 'foldrAssocsDesc' .
foldrAssocsDesc' :: (k -> a -> b -> b) -> Map k a -> b -> b
foldrAssocsDesc' f (Map t) b0 = AVL.foldlAVL' (\b (k,a) -> f k a b) b0 t  -- Strict left fold!!
{-# INLINE foldrAssocsDesc' #-}

-------------------------------------------------------
----        Conversion to sorted Lists             ----
-------------------------------------------------------

-- | /O(n)/. Convert to an ascending list of key\/value pairs.
assocsAsc :: Map k a -> [(k,a)]
assocsAsc (Map t) = AVL.asListL t
{-# INLINE assocsAsc #-}

-- | /O(n)/. Convert to an descending list of key\/value pairs.
assocsDesc :: Map k a -> [(k,a)]
assocsDesc (Map t) = AVL.asListR t
{-# INLINE assocsDesc #-}

-- | /O(n)/. Convert to a list of values in ascending order of keys.
elemsAsc :: Map k a -> [a]
elemsAsc (Map t) = AVL.foldrAVL (\(_,a) as -> a:as) [] t -- Lazy foldr
{-# INLINE elemsAsc #-}

-- | /O(n)/. Convert to a list of values in descending order of keys.
elemsDesc :: Map k a -> [a]
elemsDesc (Map t) = AVL.foldlAVL (\as (_,a) -> a:as) [] t -- Lazy foldl
{-# INLINE elemsDesc #-}

-- | /O(n)/. Convert to a list of keys in ascending order.
keysAsc :: Map k a -> [k]
keysAsc (Map t) = AVL.foldrAVL (\(k,_) ks -> k:ks) [] t -- Lazy foldr
{-# INLINE keysAsc #-}

-- | /O(n)/. Convert to a list of keys in descending order.
keysDesc :: Map k a -> [k]
keysDesc (Map t) = AVL.foldlAVL (\ks (k,_) -> k:ks) [] t -- Lazy foldl
{-# INLINE keysDesc #-}

-------------------------------------------------------
----       Conversion from sorted Lists            ----
-------------------------------------------------------
-- | /O(n)/. Build a map from an ascending list of associations with distinct keys
-- (no duplicates) in linear time. /The precondition is not checked./
fromDistinctAscList :: [(k,a)] -> Map k a
fromDistinctAscList pairs = Map (AVL.asTreeL pairs)
{-# INLINE fromDistinctAscList #-}

-- | /O(n)/. Build a map from an ascending list in linear time with a
-- combining function for equal keys. /The precondition (input list is ascending) is not checked./
--
-- Given a combining function @f@ and a consecutive block (sub-list) of associations @assocs@
-- with the same key, then the resulting combined association @assoc@ is given by:
--
-- @assoc = 'Data.List.foldl1'  (\(_,a) (k',a') -> (k', f a' a)) assocs@
--
fromAscListWith :: Eq k => (a -> a -> a) -> [(k,a)] -> Map k a
fromAscListWith f = fromAscListWithKey (\_ x y -> f x y)
{-# INLINE fromAscListWith #-}

-- | /O(n)/. Build a map from an ascending list in linear time with a
-- combining function for equal keys. /The precondition (input list is ascending) is not checked./
--
-- Given a combining function @f@ and a consecutive block (sub-list) of associations @assocs@
-- with the same key, then the resulting combined association @assoc@ is given by:
--
-- @assoc = 'Data.List.foldl1' (\(_,a) (k',a') -> (k', f k' a' a)) assocs@
--
fromAscListWithKey :: Eq k => (k -> a -> a -> a) -> [(k,a)] -> Map k a
fromAscListWithKey f = noDup where
 noDup []       = empty
 noDup (ka:kas) = noDup' [] 1 ka kas -- n = (length kasR)+1
 noDup' kasR n ka       []                = Map (AVL.asTreeLenR n (ka:kasR)) -- kasR is descending!
 noDup' kasR n ka@(k,a) (ka'@(k',a'):kas) =
  if k==k' then let a'' = f k' a' a  -- New key is same as old, so combine them
                in  noDup' kasR n (k',a'') kas
           else let n' = n+1         -- New key is different so push old and replace with new
                in  n' `seq` noDup' (ka:kasR) n' ka' kas

-- | /O(n)/. Build a map from an descending list of associations with distinct keys
-- (no duplicates) in linear time. /The precondition is not checked./
fromDistinctDescList :: [(k,a)] -> Map k a
fromDistinctDescList pairs = Map (AVL.asTreeR pairs)
{-# INLINE fromDistinctDescList #-}

-- | /O(n)/. Build a map from an descending list in linear time with a
-- combining function for equal keys. /The precondition (input list is ascending) is not checked./
--
-- Given a combining function @f@ and a consecutive block (sub-list) of associations @assocs@
-- with the same key, then the resulting combined association @assoc@ is given by:
--
-- @assoc = 'Data.List.foldl1'  (\(_,a) (k',a') -> (k', f a' a)) assocs@
--
fromDescListWith :: Eq k => (a -> a -> a) -> [(k,a)] -> Map k a
fromDescListWith f = fromDescListWithKey (\_ x y -> f x y)
{-# INLINE fromDescListWith #-}

-- | /O(n)/. Build a map from an descending list in linear time with a
-- combining function for equal keys. /The precondition (input list is ascending) is not checked./
--
-- Given a combining function @f@ and a consecutive block (sub-list) of associations @assocs@
-- with the same key, then the resulting combined association @assoc@ is given by:
--
-- @assoc = 'Data.List.foldl1'  (\(_,a) (k',a') -> (k', f k' a' a)) assocs@
--
fromDescListWithKey :: Eq k => (k -> a -> a -> a) -> [(k,a)] -> Map k a
fromDescListWithKey f = noDup where
 noDup []       = empty
 noDup (ka:kas) = noDup' [] 1 ka kas -- n = (length kasR)+1
 noDup' kasR n ka       []                = Map (AVL.asTreeLenL n (ka:kasR)) -- kasR is ascending!
 noDup' kasR n ka@(k,a) (ka'@(k',a'):kas) =
  if k==k' then let a'' = f k' a' a  -- New key is same as old, so combine them
                in  noDup' kasR n (k',a'') kas
           else let n' = n+1         -- New key is different so push old and replace with new
                in  n' `seq` noDup' (ka:kasR) n' ka' kas

-------------------------------------------------------
----     Strict conversion from sorted Lists       ----
-------------------------------------------------------
-- | /O(n)/. This is the strict version of 'fromAscListWith'.
fromAscListWith' :: Eq k => (a -> a -> a) -> [(k,a)] -> Map k a
fromAscListWith' f = fromAscListWithKey' (\_ x y -> f x y)
{-# INLINE fromAscListWith' #-}

-- | /O(n)/. This is the strict version of 'fromAscListWithKey'.
fromAscListWithKey' :: Eq k => (k -> a -> a -> a) -> [(k,a)] -> Map k a
fromAscListWithKey' f = merge where
 merge []       = empty
 merge (ka:kas) = merge' [] 1 ka kas -- n = (length kasR)+1
 merge' kasR n ka       []                = Map (AVL.asTreeLenR n (ka:kasR)) -- kasR is descending!
 merge' kasR n ka@(k,a) (ka'@(k',a'):kas) =
  if k==k' then let a'' = f k' a' a  -- New key is same as old, so combine them
                in  a'' `seq` merge' kasR n (k',a'') kas
           else let n' = n+1         -- New key is different so push old and replace with new
                in  n' `seq` merge' (ka:kasR) n' ka' kas

-- | /O(n)/. This is the strict version of 'fromDescListWith'.
fromDescListWith' :: Eq k => (a -> a -> a) -> [(k,a)] -> Map k a
fromDescListWith' f = fromDescListWithKey' (\_ x y -> f x y)
{-# INLINE fromDescListWith' #-}

-- | /O(n)/. This is the strict version of 'fromDescListWithKey'.
fromDescListWithKey' :: Eq k => (k -> a -> a -> a) -> [(k,a)] -> Map k a
fromDescListWithKey' f = merge where
 merge []       = empty
 merge (ka:kas) = merge' [] 1 ka kas -- n = (length kasR)+1
 merge' kasR n ka       []                = Map (AVL.asTreeLenL n (ka:kasR)) -- kasR is ascending!
 merge' kasR n ka@(k,a) (ka'@(k',a'):kas) =
  if k==k' then let a'' = f k' a' a  -- New key is same as old, so combine them
                in  a'' `seq` merge' kasR n (k',a'') kas
           else let n' = n+1         -- New key is different so push old and replace with new
                in  n' `seq` merge' (ka:kasR) n' ka' kas


-------------------------------------------------------
----      Conversion from unsorted Lists           ----
-------------------------------------------------------
-- | /O(n*log n)/. Build a map from an unsorted list of distinct key\/value pairs.
-- This function raises an error if duplicate keys are found.
fromDistinctList :: Ord k => [(k,a)] -> Map k a
fromDistinctList l = Map (AVL.genAsTree cmp l)
 where cmp (k,_) (k',_) = case compare k k' of
                          LT -> COrdering.Lt
                          EQ -> error "Map.fromDistinctList: Duplicate key found."
                          GT -> COrdering.Gt

-- | /O(n*log n)/.
-- Build a map from an /unsorted/ list of key\/value pairs with a combining function.
-- If the supplied list contains multiple values bound to the same key then the
-- associations are combined as if by..
--
-- @assoc = 'Data.List.foldl1'  (\(k,a) (_,a') -> (k, f a' a)) assocs@
--
-- .. where the order of associations in @assocs@ is the same as that in the supplied list.
fromListWith :: Ord k => (a -> a -> a) -> [(k,a)] -> Map k a
fromListWith f pairs = Map (AVL.genAsTree cmp pairs)
 where cmp (k,a) (k',a') = case compare k k' of
                           LT -> COrdering.Lt
                           EQ -> COrdering.Eq (k', f a a')  -- Note Argument order!!
                           GT -> COrdering.Gt

-- | /O(n*log n)/.
-- Build a map from an /unsorted/ list of key\/value pairs with a combining function.
-- If the supplied list contains multiple values bound to the same key then the
-- associations are combined as if by ..
--
-- @assoc = 'Data.List.foldl1'  (\(k,a) (_,a') -> (k, f k a' a)) assocs@
--
-- .. where the order of associations in @assocs@ is the same as that in the supplied list.
fromListWithKey :: Ord k => (k -> a -> a -> a) -> [(k,a)] -> Map k a
fromListWithKey f pairs = Map (AVL.genAsTree cmp pairs)
 where cmp (k,a) (k',a') = case compare k k' of
                           LT -> COrdering.Lt
                           EQ -> COrdering.Eq (k', f k' a a')  -- Note Argument order!!
                           GT -> COrdering.Gt

-------------------------------------------------------
----      Strict conversion from unsorted Lists    ----
-------------------------------------------------------
-- | /O(n*log n)/. This version of 'fromListWith' applies the combining function strictly.
fromListWith' :: Ord k => (a -> a -> a) -> [(k,a)] -> Map k a
fromListWith' f pairs = Map (AVL.genAsTree cmp pairs)
 where cmp (k,a) (k',a') = case compare k k' of
                           LT -> COrdering.Lt
                           EQ -> let a'' = f a a' in a'' `seq` COrdering.Eq (k', a'')  -- Note Argument order!!
                           GT -> COrdering.Gt

-- | /O(n*log n)/. This version of 'fromListWithKey' applies the combining function strictly.
fromListWithKey' :: Ord k => (k -> a -> a -> a) -> [(k,a)] -> Map k a
fromListWithKey' f pairs = Map (AVL.genAsTree cmp pairs)
 where cmp (k,a) (k',a') = case compare k k' of
                           LT -> COrdering.Lt
                           EQ -> let a'' = f k' a a' in a'' `seq` COrdering.Eq (k', a'')  -- Note Argument order!!
                           GT -> COrdering.Gt

-------------------------------------------------------
----           Other conversions                   ----
-------------------------------------------------------

-- | /O(n)/. The set of all keys of the map.
keysSet :: Map k a -> Set.Set k
keysSet (Map t) = Set.unsafeFromTree (AVL.mapAVL' fst t) -- Uses strict map
{-# INLINE keysSet #-}

-- | /O(n)/. Apply a function to each element of a set and return the resulting map.
liftKeysSet :: (k -> b) -> Set.Set k -> Map k b
-- N.B. Uses strict map, but this does not force evaluation of (f k)
liftKeysSet f = unsafeFromTree . AVL.mapAVL' (\k -> (k,f k)) . Set.toTree
{-# INLINE liftKeysSet #-}

-- | /O(n)/. This version of 'liftKeysSet' applies the supplied function strictly.
liftKeysSet' :: (k -> b) -> Set.Set k -> Map k b
liftKeysSet' f = unsafeFromTree . AVL.mapAVL' (\k -> let b = f k in b `seq` (k,b)) . Set.toTree
{-# INLINE liftKeysSet' #-}

-- | /O(1)/. Convert a /sorted/ AVL tree to an AVL tree based Map (as provided by this module).
-- This function does not check the input AVL tree is sorted.
unsafeFromTree :: AVL.AVL (k,a) -> Map k a
unsafeFromTree = Map
{-# INLINE unsafeFromTree #-}

-- | /O(1)/. Convert an AVL tree based Map (as provided by this module) to a sorted AVL tree.
toTree :: Map k a -> AVL.AVL (k,a)
toTree (Map t) = t
{-# INLINE toTree #-}

-------------------------------------------------------
----                 Filter                        ----
-------------------------------------------------------

-- | /O(n)/. Filter all values that satisfy the predicate.
filter :: Ord k => (a -> Bool) -> Map k a -> Map k a
filter p (Map t) = Map (AVL.filterAVL (\(_,a) -> p a) t)
{-# INLINE filter #-}

-- | /O(n)/. Filter all keys\/values that satisfy the predicate.
filterWithKey :: Ord k => (k -> a -> Bool) -> Map k a -> Map k a
filterWithKey p (Map t) = Map (AVL.filterAVL (\(k,a) -> p k a) t)
{-# INLINE filterWithKey #-}

-- | /O(n)/. partition the map according to a predicate. The first
-- map contains all elements that satisfy the predicate, the second all
-- elements that fail the predicate.
partition :: Ord k => (a -> Bool) -> Map k a -> (Map k a,Map k a)
partition p (Map t) = let (t1, t2) = AVL.partitionAVL (\(_,a) -> p a) t
                      in (Map t1, Map t2)
{-# INLINE partition #-}

-- | /O(n)/. partition the map according to a predicate. The first
-- map contains all elements that satisfy the predicate, the second all
-- elements that fail the predicate.
partitionWithKey :: Ord k => (k -> a -> Bool) -> Map k a -> (Map k a,Map k a)
partitionWithKey p (Map t) = let (t1, t2) = AVL.partitionAVL (\(k,a) -> p k a) t
                             in (Map t1, Map t2)
{-# INLINE partitionWithKey #-}

-- | /O(log n)/. The expression (@'split' x set@) is a pair @(set1,set2)@
-- where all elements in @set1@ are lower than @x@ and all elements in
-- @set2@ larger than @x@. @x@ is not found in neither @set1@ nor @set2@.
split :: Ord k => k -> Map k a -> (Map k a,Map k a)
split k (Map t) = (Map lessT, Map greaterT)
 where (lessT, _, greaterT) = AVL.genFork (readValCC k) t
{-# INLINE split #-}

-- | /O(log n)/. The expression (@'splitLookup' k map@) splits a map just
-- like 'split' but also returns @'lookup' k map@.
splitLookup :: Ord k => k -> Map k a -> (Map k a,Maybe a,Map k a)
splitLookup k (Map t) = (Map lessT, mba, Map greaterT)
 where (lessT, mba, greaterT) = AVL.genFork (readValCC k) t
{-# INLINE splitLookup #-}


-- | /O(n)/. Remove all values for which the supplied function returns 'Nothing'.
mapMaybe :: (a -> Maybe b) -> Map k a -> Map k b
mapMaybe f (Map t) = Map (AVL.mapMaybeAVL f' t)
 where f' (k,a) = case f a of
                  Nothing -> Nothing
                  Just b  -> Just (k,b)

-- | /O(n)/. Remove all values for which the supplied function returns 'Nothing'.
mapMaybeKey :: (k -> a -> Maybe b) -> Map k a -> Map k b
mapMaybeKey f (Map t) = Map (AVL.mapMaybeAVL f' t)
 where f' (k,a) = case f k a of
                  Nothing -> Nothing
                  Just b  -> Just (k,b)

-------------------------------------------------------
----                  Submap                       ----
-------------------------------------------------------
-- | /O(n+m)/.
-- This function is defined as (@'isSubmapOf' = 'isSubmapOfBy' (==)@).
isSubmapOf :: (Ord k,Eq a) => Map k a -> Map k a -> Bool
isSubmapOf = isSubmapOfBy (==)
{-# INLINE isSubmapOf #-}

{- | /O(n+m)/.
 The expression (@'isSubmapOfBy' f t1 t2@) returns 'True' if
 all keys in @t1@ are in tree @t2@, and when @f@ returns 'True' when
 applied to their respective values. For example, the following
 expressions are all 'True':

 > isSubmapOfBy (==) (fromList [('a',1)]) (fromList [('a',1),('b',2)])
 > isSubmapOfBy (<=) (fromList [('a',1)]) (fromList [('a',1),('b',2)])
 > isSubmapOfBy (==) (fromList [('a',1),('b',2)]) (fromList [('a',1),('b',2)])

 But the following are all 'False':

 > isSubmapOfBy (==) (fromList [('a',2)]) (fromList [('a',1),('b',2)])
 > isSubmapOfBy (<)  (fromList [('a',1)]) (fromList [('a',1),('b',2)])
 > isSubmapOfBy (==) (fromList [('a',1),('b',2)]) (fromList [('a',1)])
-}
isSubmapOfBy :: Ord k => (a->b->Bool) -> Map k a -> Map k b -> Bool
isSubmapOfBy p (Map ta) (Map tb) = AVL.genIsSubsetOfBy cmp ta tb
 where cmp (k,a) (k',b) = case compare k k' of
                          LT -> COrdering.Lt
                          EQ -> COrdering.Eq $! p a b
                          GT -> COrdering.Gt

-- | /O(n+m)/. Is this a proper submap? (ie. a submap but not equal).
-- Defined as (@'isProperSubmapOf' = 'isProperSubmapOfBy' (==)@).
isProperSubmapOf :: (Ord k,Eq a) => Map k a -> Map k a -> Bool
isProperSubmapOf m1 m2 = isProperSubmapOfBy (==) m1 m2
{-# INLINE isProperSubmapOf #-}

{- | /O(n+m)/. Is this a proper submap? (ie. a submap but not equal).
 The expression (@'isProperSubmapOfBy' f m1 m2@) returns 'True' when
 @m1@ and @m2@ are not equal,
 all keys in @m1@ are in @m2@, and when @f@ returns 'True' when
 applied to their respective values. For example, the following
 expressions are all 'True':

  > isProperSubmapOfBy (==) (fromList [(1,1)]) (fromList [(1,1),(2,2)])
  > isProperSubmapOfBy (<=) (fromList [(1,1)]) (fromList [(1,1),(2,2)])

 But the following are all 'False':

  > isProperSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1),(2,2)])
  > isProperSubmapOfBy (==) (fromList [(1,1),(2,2)]) (fromList [(1,1)])
  > isProperSubmapOfBy (<)  (fromList [(1,1)])       (fromList [(1,1),(2,2)])
-}
isProperSubmapOfBy :: Ord k => (a->b->Bool) -> Map k a -> Map k b -> Bool
isProperSubmapOfBy f ma@(Map ta) mb@(Map tb) = (AVL.size ta < AVL.size tb) && (isSubmapOfBy f ma mb)
{-# INLINE isProperSubmapOfBy #-}

-------------------------------------------------------
----                 Min/Max                       ----
-------------------------------------------------------
-- | /O(log n)/. The minimal key of the map. Raises an error if the map is empty.
findMin :: Map k a -> (k,a)
findMin (Map t) = AVL.assertReadL t
{-# INLINE findMin #-}

-- | /O(log n)/. Delete the minimal key. Raises an error if the map is empty.
deleteMin :: Map k a -> Map k a
deleteMin (Map t) = Map (AVL.delL t)
{-# INLINE deleteMin #-}

-- | /O(log n)/. Delete and find the minimal element.
deleteFindMin :: Map k a -> ((k,a),Map k a)
deleteFindMin (Map t) =
 case AVL.tryPopL t of
 Just (assoc,t') -> (assoc, Map t')
 Nothing         -> (error "Map.deleteFindMin: can not return the minimal element of an empty map"
                    ,empty)

-- | /O(log n)/. Delete and find the maximal element.
deleteFindMax :: Map k a -> ((k,a),Map k a)
deleteFindMax (Map t) =
 case AVL.tryPopR t of
 Just (t',assoc) -> (assoc, Map t')
 Nothing         -> (error "Map.deleteFindMax: can not return the maximal element of an empty map"
                    ,empty)

-- | /O(log n)/. The maximal key of the map. Raises an error if the map is empty.
findMax :: Map k a -> (k,a)
findMax (Map t) = AVL.assertReadR t
{-# INLINE findMax #-}

-- | /O(log n)/. Delete the maximal key. Raises an error if the map is empty.
deleteMax :: Map k a -> Map k a
deleteMax (Map t) = Map (AVL.delR t)
{-# INLINE deleteMax #-}

-- | /O(log n)/. Update the value at the minimal key.
updateMin :: (a -> Maybe a) -> Map k a -> Map k a
updateMin f m = updateMinWithKey (\_ x -> f x) m
{-# INLINE updateMin #-}

-- | /O(log n)/. Update the value at the maximal key.
updateMax :: (a -> Maybe a) -> Map k a -> Map k a
updateMax f m = updateMaxWithKey (\_ x -> f x) m
{-# INLINE updateMax #-}

-- | /O(log n)/. Update the value at the minimal key.
updateMinWithKey :: (k -> a -> Maybe a) -> Map k a -> Map k a
updateMinWithKey f mp@(Map t) =
 case (AVL.tryReadL t) of
 Nothing    -> mp
 Just (k,a) -> case f k a of
               Nothing -> Map (AVL.assertDelL t)
               Just a' -> Map (AVL.writeL (k,a') t)


-- | /O(log n)/. Update the value at the maximal key.
updateMaxWithKey :: (k -> a -> Maybe a) -> Map k a -> Map k a
updateMaxWithKey f mp@(Map t) =
 case (AVL.tryReadR t) of
 Nothing    -> mp
 Just (k,a) -> case f k a of
               Nothing -> Map (AVL.assertDelR t)
               Just a' -> Map (AVL.writeR t (k,a'))

-- | /O(log n)/. Retrieves the minimal (key,value) pair of the map, and the map stripped from that element
-- @fail@s (in the monad) when passed an empty map.
minViewWithKey :: Monad m => Map k a -> m ((k,a), Map k a)
minViewWithKey (Map t) = case AVL.tryPopL t of
                         Nothing         -> fail "Map.minViewWithKey: empty map"
                         Just (assoc,t') -> return (assoc, Map t')

-- | /O(log n)/. Retrieves the maximal (key,value) pair of the map, and the map stripped from that element
-- @fail@s (in the monad) when passed an empty map.
maxViewWithKey :: Monad m => Map k a -> m ((k,a), Map k a)
maxViewWithKey (Map t) = case AVL.tryPopR t of
                         Nothing         -> fail "Map.maxViewWithKey: empty map"
                         Just (t',assoc) -> return (assoc, Map t')

-- | /O(log n)/. Retrieves the minimal key\'s value of the map, and the map stripped from that element
-- @fail@s (in the monad) when passed an empty map.
minView :: Monad m => Map k a -> m (a, Map k a)
minView (Map t) = case AVL.tryPopL t of
                  Nothing         -> fail "Map.minView: empty map"
                  Just ((_,a),t') -> return (a, Map t')

-- | /O(log n)/. Retrieves the maximal key\'s value of the map, and the map stripped from that element
-- @fail@s (in the monad) when passed an empty map.
maxView :: Monad m => Map k a -> m (a, Map k a)
maxView (Map t) = case AVL.tryPopR t of
                  Nothing         -> fail "Map.maxView: empty map"
                  Just (t',(_,a)) -> return (a, Map t')


------------------------------------------------------
----        Open Map type and operations          ----
------------------------------------------------------
-- | An \"open map\", obtained from a 'Map' using 'openMap'.
--
-- An 'OMap' is simply an abstract wrapper containing a map, a key (both of which
-- are arguments supplied to 'openMap'), and a \"binary path\" which encodes the path
-- to the corresponding association in the underlying tree. This enables it to be
-- found again if necessary without repeating all the comparisons.
--
-- Unfortunately the above mentioned \"binary path\" is only valid provided tree shape
-- does not change (no insertions or deletions). So the path is discarded when one of
-- the various delete or write operations is invoked (these return a 'Map', not an 'OMap').
data OMap k a = OMap k (AVL.BAVL (k,a))

-- | /O(log n)/. Open a Map at a the supplied current key
openMap :: Ord k => k -> Map k a -> OMap k a
openMap k (Map t) = OMap k (AVL.genOpenBAVL cmp t)
 where cmp (k',_) = compare k k'
{-# INLINE openMap #-}

-- | /O(1)/. Read the value associated with the current key.
-- Returns Nothing if the search failed when the OMap was created
readOMap :: OMap k a -> Maybe a
readOMap (OMap _ bavl) = case AVL.tryReadBAVL bavl of
                         Nothing    -> Nothing
                         Just (_,a) -> Just a
{-# INLINE readOMap #-}

-- | /O(1)/. Similar to 'readOMap', but returns the actual key\/value association
-- pair from the Map.
readAssocOMap :: OMap k a -> Maybe (k,a)
readAssocOMap (OMap _ bavl) = AVL.tryReadBAVL bavl
{-# INLINE readAssocOMap #-}

-- | /O(log n)/. Delete the association at the current key
-- (/O(1)/ if the search failed when the OMap was created)
deleteOMap :: OMap k a -> Map k a
deleteOMap (OMap _ bavl) = Map (AVL.deleteBAVL bavl)
{-# INLINE deleteOMap #-}

-- | /O(log n)/. Set a new associated value for the current key. If the search succeeded
-- when the Map was opened then the key from the original association pair is used
-- (in preference to that supplied when the Map was opened).
writeOMap :: a -> OMap k a -> Map k a
writeOMap a (OMap k bavl) = case AVL.tryReadBAVL bavl of
                            Nothing     -> Map (AVL.pushBAVL (k ,a) bavl)
                            Just (k',_) -> Map (AVL.pushBAVL (k',a) bavl)
{-# INLINE writeOMap #-}

-- | /O(log n)/. Similar to 'writeOMap', but the key that is used in the new association
-- pair is always that supplied when the Map was opened, not that from the original
-- association pair (if any).
writeNewKeyOMap :: a -> OMap k a -> Map k a
writeNewKeyOMap a (OMap k bavl) = Map (AVL.pushBAVL (k,a) bavl)
{-# INLINE writeNewKeyOMap #-}

-- | /O(1)/. Close OMap, leaving the Map unmodified.
-- Typically you won't need this if you still have the original Map in scope.
closeOMap :: OMap k a -> Map k a
closeOMap (OMap _ bavl) = Map (AVL.closeBAVL bavl)
{-# INLINE closeOMap #-}

-- | /O(1)/. Get the current key. If the search succeeded when the Map was opened
-- this function returns the key from the Map. Otherwise it returns the key
-- that was supplied as an argument of 'openMap'.
readKeyOMap :: OMap k a -> k
readKeyOMap (OMap k bavl) = case AVL.tryReadBAVL bavl of
                            Nothing     -> k
                            Just (k',_) -> k'
{-# INLINE readKeyOMap #-}

------------------------------------------------------
----  local combining comparison utilities  ----------
------------------------------------------------------
readValCC :: Ord k => k -> (k, a) -> COrdering.COrdering a
readValCC k (k', a) = case compare k k' of
                      LT -> COrdering.Lt
                      EQ -> COrdering.Eq a
                      GT -> COrdering.Gt

-------------------------------------------------------
----               Instances                       ----
-------------------------------------------------------

-- Eq --
instance (Eq k, Eq a) => Eq (Map k a) where
 m1 == m2 = assocsAsc m1 == assocsAsc m2

-- Ord --
instance (Ord k, Ord a) => Ord (Map k a) where
 compare m1 m2 = compare (assocsAsc m1) (assocsAsc m2)

-- Show --
instance (Show k, Show a) => Show (Map k a) where
  showsPrec d m  = showParen (d > 10) $
    showString "fromDistinctList " . shows (assocsAsc m)

-- Read --
#ifdef __GLASGOW_HASKELL__
instance (Ord k, R.Read k, R.Read e) => R.Read (Map k e) where
 readPrec = R.parens $ R.prec 10 $ do R.Ident "fromDistinctList" <- R.lexP
                                      xs <- R.readPrec
                                      return (fromList xs)
 readListPrec = R.readListPrecDefault
#else
instance (Ord k, Read k, Read e) => Read (Map k e) where
  readsPrec p = readParen (p > 10) $ \ r -> do ("fromDistinctList",s) <- lex r
                                               (xs,t) <- reads s
                                               return (fromDistinctList xs,t)
#endif

-- Functor --
instance Functor (Map k) where
 fmap = map -- The lazy version

-- Monoid --
instance (Ord k, M.Monoid v) => M.Monoid (Map k v) where
 mempty            = empty
 mappend map0 map1 = unionWith M.mappend map0 map1
 mconcat maps      = L.foldr (unionWith M.mappend) empty maps

-- Foldable --
instance F.Foldable (Map k) where
 -- fold :: Monoid m => Map k m -> m
 fold (Map t) = AVL.foldrAVL (\(_,a) b -> M.mappend a b) M.mempty t  -- Non-strict right fold!!

 -- foldMap :: Monoid m => (a -> m) -> Map k a -> m
 foldMap f (Map t) = AVL.foldrAVL (\(_,a) b -> M.mappend (f a) b) M.mempty t  -- Non-strict right fold!!

 -- foldr :: (a -> b -> b) -> b -> Map k a -> b
 foldr f b0 (Map t) = AVL.foldrAVL (\(_,a) b -> f a b) b0 t  -- Non-strict right fold!!

 -- foldl :: (a -> b -> a) -> a -> Map k b -> a
 foldl f b0 (Map t) = AVL.foldlAVL (\a (_,b) -> f a b) b0 t  -- Non-strict left fold!!

 -- foldr1 :: (a -> a -> a) -> Map k a -> a
 foldr1 f (Map t) = case AVL.tryPopR t of
                    Nothing          -> error "Data.Map.AVL.Foldable.foldr1: Empty Map."
                    Just (t0,(_,a0)) -> AVL.foldrAVL (\(_,a) a' -> f a a') a0 t0

 -- foldl1 :: (a -> a -> a) -> Map k a -> a
 foldl1 f (Map t) = case AVL.tryPopL t of
                    Nothing          -> error "Data.Map.AVL.Foldable.foldl1: Empty Map."
                    Just ((_,a0),t0) -> AVL.foldlAVL (\a (_,a') -> f a a') a0 t0

-------------------------------------------------------
----               Debugging                       ----
-------------------------------------------------------
-- | /O(n)/. Test if the internal map structure is valid.
valid :: Ord k => Map k a -> Bool
valid (Map t) = AVL.isSortedOK (\(k,_) (k',_) -> compare k k') t

-------------------------------------------------------
----                DEPRECATED                    ----
-------------------------------------------------------

{-# DEPRECATED unions,unionsWith "Please roll your own." #-}
-- | The union of a list of maps:
--   (@'unions' == 'Data.List.foldl'' 'union' 'empty'@).
--
-- Please roll your own.
unions :: Ord k => [Map k a] -> Map k a
unions ts = L.foldl' union empty ts
{-# INLINE unions #-}

-- | The union of a list of maps, with a combining operation:
--   (@'unionsWith' f == 'Data.List.foldl'' ('unionWith' f) 'empty'@).
--
-- Please roll your own.
unionsWith :: Ord k => (a->a->a) -> [Map k a] -> Map k a
unionsWith f ts = L.foldl' (unionWith f) empty ts
{-# INLINE unionsWith #-}

{-# DEPRECATED differenceWith "This function is now called differenceMaybe." #-}
-- | /O(n+m)/. Difference with a combining function. If the combining function returns
-- @Just a@ then the corresponding association is not deleted from the result 'Map'
-- (it is retained with @a@ as the associated value).
--
-- This function is now called 'differenceMaybe'.
differenceWith :: Ord k => (a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a
differenceWith = differenceMaybe
{-# INLINE differenceWith #-}

{-# DEPRECATED differenceWithKey "This function is now called differenceMaybeKey." #-}
-- | /O(n+m)/. Same as differenceWith, but the key is also an argument of the combining function.
--
-- This function is now called 'differenceMaybeKey'.
differenceWithKey :: Ord k => (k -> a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a
differenceWithKey = differenceMaybeKey
{-# INLINE differenceWithKey #-}

{-# DEPRECATED assocs "This function is now called assocsAsc." #-}
-- | /O(n)/. Synonym for 'assocsAsc'.
--
-- This function is now called 'assocsAsc'.
assocs :: Map k a -> [(k,a)]
assocs = assocsAsc
{-# INLINE assocs #-}

{-# DEPRECATED toList "This function is now called assocsAsc." #-}
-- | /O(n)/. Convert to a list of key\/value pairs.
--
-- Please use 'assocsAsc' instead.
toList :: Map k a -> [(k,a)]
toList = assocsAsc
{-# INLINE toList #-}

{-# DEPRECATED toAscList "This function is now called assocsAsc." #-}
-- | /O(n)/. Convert to a list of key\/value pairs.
--
-- Please use 'assocsAsc' instead.
toAscList :: Map k a -> [(k,a)]
toAscList = assocsAsc
{-# INLINE toAscList #-}

{-# DEPRECATED fromList "Please fromDistinctList or fromListWith." #-}
-- | /O(n*log n)/. Build a map from an unsorted list of key\/value pairs.
-- If equal keys are bound to multiple values in the list then only the last
-- will be present in the resulting Map.
--
-- This function seems not very useful in practice and is therefore deprecated.
-- Try using 'fromDistinctList' or 'fromListWith' instead.
fromList :: Ord k => [(k,a)] -> Map k a
fromList l = Map (AVL.genAsTree cmp l)
 where cmp new@(k,_) (k',_) = case compare k k' of
                              LT -> COrdering.Lt
                              EQ -> COrdering.Eq new
                              GT -> COrdering.Gt

{-# DEPRECATED elems "This function is now called elemsAsc." #-}
-- | /O(n)/. Synonym for 'elemsAsc'.
--
-- Please use 'elemsAsc' instead.
elems :: Map k a -> [a]
elems = elemsAsc
{-# INLINE elems #-}

{-# DEPRECATED keys "This function is now called keysAsc." #-}
-- | /O(n)/. Synonym for 'keysAsc'.
--
-- Please use 'keysAsc' instead.
keys :: Map k a -> [k]
keys = keysAsc
{-# INLINE keys #-}

{-# DEPRECATED fromAscList "Please use fromDistinctAscList or fromAscListWith." #-}
-- | /O(n)/. Build a map from an ascending list in linear time.
-- /The precondition (input list is ascending) is not checked./
--
-- Given a consecutive block (sub-list) of associations with the same key,
-- then only the /last/ association will appear in the map (the rest are discarded).
--
-- This function seems not very useful in practice and is therefore deprecated.
-- Try using 'fromDistinctAscList' or 'fromAscListWith' instead
fromAscList :: Eq k => [(k,a)] -> Map k a
fromAscList = fromAscListWithKey' (\_ x _ -> x) -- Uses the strict version!
{-# INLINE fromAscList #-}

{-# DEPRECATED mapKeys "Please roll your own." #-}
-- | /O(n*log n)/.
-- @'mapKeys' f s@ is the map obtained by applying @f@ to each key of @s@.
--
-- The size of the result may be smaller if @f@ maps two or more distinct
-- keys to the same new key.  In this case the value at the /largest/ of
-- these keys is retained.
--
-- /Note:/ This behaviour is consistent with the actual implementation in the
-- original Data.Map, but not with the documentation (which states that the value
-- at the /smallest/ of these keys is retained).
--
-- This function seems not very useful in practice and is therefore deprecated.
-- Try using 'mapKeysWith', 'mapKeysOneToOne' or 'mapKeysMonotonic' instead.
mapKeys :: Ord k2 => (k1->k2) -> Map k1 a -> Map k2 a
mapKeys f (Map tk1) = Map (L.foldl' addAssoc AVL.empty (mapf (AVL.asListL tk1)))
 where mapf []             = []
       mapf ((k1,a):pairs) = let k2 = f k1 in k2 `seq` (k2,a):(mapf pairs)
       addAssoc tk2 assoc@(k2,a) = AVL.genPush cmp assoc tk2
        where cmp (k2',_) = case compare k2 k2' of
                            LT -> COrdering.Lt
                            EQ -> COrdering.Eq (k2',a)
                            GT -> COrdering.Gt

{-# DEPRECATED insertLookupWithKey "Please roll your own." #-}
-- | /O(log n)/. The expression (@'insertLookupWithKey' f k x map@)
-- is a pair where the first element is equal to (@'lookup' k map@)
-- and the second element equal to (@'insertWithKey' f k x map@).
--
-- This function is deprecated becuase the 'OMap' type and associated functions
-- provide a way to implement this and many more variants of hybrid operations
-- like this. So please roll your own as needed.
insertLookupWithKey :: Ord k => (k -> a -> a -> a) -> k -> a -> Map k a -> (Maybe a,Map k a)
insertLookupWithKey f k a mp = case readOMap omap of
                               Nothing      -> (Nothing, writeOMap a          omap)
                               ja@(Just a') -> (ja     , writeOMap (f k a a') omap)
 where omap = openMap k mp

{-# DEPRECATED updateLookupWithKey "Please roll your own." #-}
-- | /O(log n)/. Lookup and update.
--
-- NOTE: There seems to be an oddity in the original implementation of this in that
-- the search succeeds and the combining function returns @Just a@ the @a@ is what
-- you get as looked up value (I.E. the /new/ associated value). If it returns
-- 'Nothing' (I.E. the association is deleted) you get the /old/ associated value.
-- This seems pretty daft, but this implementation replicates this behaviour.
--
-- This function is deprecated becuase the 'OMap' type and associated functions
-- provide a way to implement this and many more variants of hybrid operations
-- like this. So please roll your own as needed.
updateLookupWithKey :: Ord k => (k -> a -> Maybe a) -> k -> Map k a -> (Maybe a,Map k a)
updateLookupWithKey f k mp = case readOMap omap of
                             Nothing     -> (Nothing, mp)
                             ja@(Just a) -> case f k a of
                                            Nothing       ->(ja , deleteOMap   omap)
                                            ja'@(Just a') ->(ja', writeOMap a' omap)
 where omap = openMap k mp

{-# DEPRECATED readOMapKey "This function is now called readKeyOMap." #-}
-- | This function has been renamed to 'readKeyOMap'.
readOMapKey :: OMap k a -> k
readOMapKey = readKeyOMap
{-# INLINE readOMapKey #-}