{-# OPTIONS_GHC -fglasgow-exts -fno-warn-unused-imports #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Trie.General.OrdGT
-- Copyright   :  (c) Adrian Hey 2007
-- License     :  BSD3
--
-- Maintainer  :  http://homepages.nildram.co.uk/~ahey/em.png
-- Stability   :  provisional
-- Portability :  non-portable
--
-- A 'GT' instance for keys of type @'Ord' k => k@
--
-- This module defines the a default instance of the 'Data.Trie.General.GT'
-- class for any instance of 'Ord', using 'Data.Tree.AVL.AVL' trees. Note it
-- /is not/ and instance of GT /for/ 'Data.Tree.AVL.AVL' trees.
-----------------------------------------------------------------------------
module Data.Trie.General.OrdGT
(-- * OrdGT type
 OrdGT

 -- * Standard GT API for OrdGTs
 -- | These functions all have the same names as the corresponding GT class methods,
 -- but with the \"OrdGT\" suffix.
,emptyOrdGT
,singletonOrdGT
,fromAssocsAscendingOrdGT
,fromAssocsDescendingOrdGT
,fromAssocsAscendingLOrdGT
,fromAssocsDescendingLOrdGT
,pairOrdGT
,isEmptyOrdGT
,isSingletonOrdGT
,nonEmptyOrdGT
,statusOrdGT
,addSizeOrdGT
,lookupOrdGT
,lookupContOrdGT
,insertOrdGT
,insertOrdGT'
,insertOrdGT''
,insertMaybeOrdGT
,insertMaybeOrdGT'
,deleteOrdGT
,deleteMaybeOrdGT
,alterOrdGT
,unionOrdGT
,unionOrdGT'
,unionMaybeOrdGT
,intersectionOrdGT
,intersectionOrdGT'
,intersectionMaybeOrdGT
,differenceOrdGT
,differenceMaybeOrdGT
,isSubsetOfOrdGT
,isSubmapOfOrdGT
,mapOrdGT
,mapOrdGT'
,mapMaybeOrdGT
,mapWithKeyOrdGT
,mapWithKeyOrdGT'
,filterOrdGT
,foldrElemsAscendingOrdGT
,foldrElemsDescendingOrdGT
,foldrKeysAscendingOrdGT
,foldrKeysDescendingOrdGT
,foldrAssocsAscendingOrdGT
,foldrAssocsDescendingOrdGT
,foldrElemsAscendingOrdGT'
,foldrElemsDescendingOrdGT'
,foldrKeysAscendingOrdGT'
,foldrKeysDescendingOrdGT'
,foldrAssocsAscendingOrdGT'
,foldrAssocsDescendingOrdGT'
,foldElemsUINTOrdGT
,validOrdGT
) where

import Data.Trie.General.Types
import qualified Data.Tree.AVL  as A
import qualified Data.COrdering as C

import qualified Data.Monoid as M (Monoid(..))
import qualified Data.Foldable as F (Foldable(..))
import Data.Typeable
-- -fno-warn-unused-imports used because ghc currently gives spurious warning with this import
-- See Tickets 1074 and 1148
import qualified Data.List as L (foldr)
import qualified Data.Maybe as MB (isJust)

#ifdef __GLASGOW_HASKELL__
import GHC.Base
import qualified Text.Read as R (Read(..),Lexeme(..),parens,prec,lexP,readListPrecDefault)
#include "ghcdefs.h"
#else
#include "h98defs.h"
#endif

-- | The default 'GT' type any key type which is an instance of 'Ord'.
-- This is a newtype wrapper around @'Data.Tree.AVL.AVL' (k,a)@.
newtype OrdGT k a = OrdGT (A.AVL (k,a))

instance Ord k => GT (OrdGT k) k where
 empty                 = emptyOrdGT
 singleton             = singletonOrdGT
 fromAssocsAscending   = fromAssocsAscendingOrdGT
 fromAssocsDescending  = fromAssocsDescendingOrdGT
 fromAssocsAscendingL  = fromAssocsAscendingLOrdGT
 fromAssocsDescendingL = fromAssocsDescendingLOrdGT
 pair                  = pairOrdGT
 isEmpty               = isEmptyOrdGT
 isSingleton           = isSingletonOrdGT
 nonEmpty              = nonEmptyOrdGT
 status                = statusOrdGT
 addSize               = addSizeOrdGT
 lookup                = lookupOrdGT
 lookupCont            = lookupContOrdGT
 insert                = insertOrdGT
 insert'               = insertOrdGT'
 insert''              = insertOrdGT''
 insertMaybe           = insertMaybeOrdGT
 insertMaybe'          = insertMaybeOrdGT'
 delete                = deleteOrdGT
 deleteMaybe           = deleteMaybeOrdGT
 alter                 = alterOrdGT
 union                 = unionOrdGT
 union'                = unionOrdGT'
 unionMaybe            = unionMaybeOrdGT
 intersection          = intersectionOrdGT
 intersection'         = intersectionOrdGT'
 intersectionMaybe     = intersectionMaybeOrdGT
 difference            = differenceOrdGT
 differenceMaybe       = differenceMaybeOrdGT
 isSubsetOf            = isSubsetOfOrdGT
 isSubmapOf            = isSubmapOfOrdGT
 map                   = mapOrdGT
 map'                  = mapOrdGT'
 mapMaybe              = mapMaybeOrdGT
 mapWithKey            = mapWithKeyOrdGT
 mapWithKey'           = mapWithKeyOrdGT'
 filter                = filterOrdGT
 foldrElemsAscending   = foldrElemsAscendingOrdGT
 foldrElemsDescending  = foldrElemsDescendingOrdGT
 foldrKeysAscending    = foldrKeysAscendingOrdGT
 foldrKeysDescending   = foldrKeysDescendingOrdGT
 foldrAssocsAscending  = foldrAssocsAscendingOrdGT
 foldrAssocsDescending = foldrAssocsDescendingOrdGT
 foldrElemsAscending'  = foldrElemsAscendingOrdGT'
 foldrElemsDescending' = foldrElemsDescendingOrdGT'
 foldrKeysAscending'   = foldrKeysAscendingOrdGT'
 foldrKeysDescending'  = foldrKeysDescendingOrdGT'
 foldrAssocsAscending' = foldrAssocsAscendingOrdGT'
 foldrAssocsDescending'= foldrAssocsDescendingOrdGT'
 foldElemsUINT         = foldElemsUINTOrdGT
 valid                 = validOrdGT

-- | See 'GT' class method 'empty'.
emptyOrdGT :: OrdGT k a
emptyOrdGT = OrdGT (A.empty)

-- | See 'GT' class method 'singleton'.
singletonOrdGT :: k -> a -> OrdGT k a
singletonOrdGT k a = OrdGT (A.singleton (k,a))
{-# INLINE singletonOrdGT #-}

-- | See 'GT' class method 'fromAssocsAscending'.
fromAssocsAscendingOrdGT :: Ord k => [(k,a)] -> OrdGT k a
fromAssocsAscendingOrdGT assocs = fromAssocsAscendingLOrdGT (length assocs) assocs
{-# INLINE fromAssocsAscendingOrdGT #-}

-- | See 'GT' class method 'fromAssocsDescending'.
fromAssocsDescendingOrdGT :: Ord k => [(k,a)] -> OrdGT k a
fromAssocsDescendingOrdGT assocs = fromAssocsDescendingLOrdGT (length assocs) assocs
{-# INLINE fromAssocsDescendingOrdGT #-}

-- | See 'GT' class method 'fromAssocsAscendingL'.
fromAssocsAscendingLOrdGT :: Ord k => Int -> [(k,a)] -> OrdGT k a
fromAssocsAscendingLOrdGT n assocs = OrdGT (A.asTreeLenL n assocs)
{-# INLINE fromAssocsAscendingLOrdGT #-}

-- | See 'GT' class method 'fromAssocsDescendingL'.
fromAssocsDescendingLOrdGT :: Ord k => Int -> [(k,a)] -> OrdGT k a
fromAssocsDescendingLOrdGT n assocs = OrdGT (A.asTreeLenR n assocs)
{-# INLINE fromAssocsDescendingLOrdGT #-}

-- | See 'GT' class method 'pair'.
pairOrdGT :: Ord k => k -> k -> Maybe (a -> a -> OrdGT k a)
pairOrdGT x y = case compare x y of
                LT -> Just (\ax ay -> OrdGT (A.pair (x,ax) (y,ay)))
                EQ -> Nothing
                GT -> Just (\ax ay -> OrdGT (A.pair (y,ay) (x,ax)))

-- | See 'GT' class method 'isEmpty'.
isEmptyOrdGT :: OrdGT k a -> Bool
isEmptyOrdGT (OrdGT t) = A.isEmpty t
{-# INLINE isEmptyOrdGT #-}

-- | See 'GT' class method 'isSingleton'.
isSingletonOrdGT :: OrdGT k a -> Bool
isSingletonOrdGT (OrdGT t) = MB.isJust (A.tryGetSingleton t)
{-# INLINE isSingletonOrdGT #-}

-- | See 'GT' class method 'nonEmpty'.
nonEmptyOrdGT :: OrdGT k a -> Maybe (OrdGT k a)
nonEmptyOrdGT m@(OrdGT t) = if A.isEmpty t then Nothing else Just m
{-# INLINE nonEmptyOrdGT #-}

-- | See 'GT' class method 'status'.
statusOrdGT :: OrdGT k a -> Status k a
statusOrdGT (OrdGT t) = case A.tryGetSingleton t of
                        Just (k,a) -> One k a
                        Nothing    -> if A.isEmpty t then None else Many
{-# INLINE statusOrdGT #-}

-- | See 'GT' class method 'addSize'.
addSizeOrdGT :: OrdGT k a -> UINT -> UINT
addSizeOrdGT (OrdGT t) n = A.fastAddSize n t
{-# INLINE addSizeOrdGT #-}

-- | See 'GT' class method 'lookup'.
lookupOrdGT :: Ord k => k -> OrdGT k a -> Maybe a
lookupOrdGT k (OrdGT t) = A.genTryRead t cmp
 where cmp (k',a) = case compare k k' of
                    LT -> C.Lt
                    EQ -> C.Eq a
                    GT -> C.Gt

-- | See 'GT' class method 'lookupCont'.
lookupContOrdGT :: Ord k => (a -> Maybe b) -> k -> OrdGT k a -> Maybe b
lookupContOrdGT f k (OrdGT t) = A.genTryReadMaybe t cmp
 where cmp (k',a) = case compare k k' of
                    LT -> C.Lt
                    EQ -> let mb = f a in mb `seq` C.Eq mb
                    GT -> C.Gt

-- | See 'GT' class method 'insert'.
insertOrdGT :: Ord k => (a -> a) -> k -> a -> OrdGT k a -> OrdGT k a
insertOrdGT f k a (OrdGT t) = OrdGT (A.genPush cmp (k,a) t)
 where cmp (k',a') = case compare k k' of
                     LT -> C.Lt
                     EQ -> C.Eq (k',f a')
                     GT -> C.Gt

-- | See 'GT' class method 'insert''.
insertOrdGT' :: Ord k => (a -> a) -> k -> a -> OrdGT k a -> OrdGT k a
insertOrdGT' f k a (OrdGT t) = OrdGT (A.genPush cmp (k,a) t)
 where cmp (k',a') = case compare k k' of
                     LT -> C.Lt
                     EQ -> let b' = f a' in b' `seq` C.Eq (k',f a')
                     GT -> C.Gt

-- | See 'GT' class method 'insert'''.
insertOrdGT'' :: Ord k => (a -> a) -> k -> a -> OrdGT k a -> OrdGT k a
insertOrdGT'' f k a (OrdGT t) = OrdGT (A.genPush' cmp (a `seq` (k,a)) t) -- Note use of genPush'
 where cmp (k',a') = case compare k k' of
                     LT -> C.Lt
                     EQ -> let b' = f a' in b' `seq` C.Eq (k',f a')
                     GT -> C.Gt

-- | See 'GT' class method 'insertMaybe'.
insertMaybeOrdGT :: Ord k => (a -> Maybe a) -> k -> a -> OrdGT k a -> OrdGT k a
insertMaybeOrdGT f k a (OrdGT t) = case A.tryReadBAVL bavl of
                                   Nothing -> OrdGT (A.pushBAVL (k,a) bavl)
                                   Just (k',a') -> case f a' of
                                                   Nothing  -> OrdGT (A.deleteBAVL bavl)
                                                   Just a'' -> OrdGT (A.pushBAVL (k',a'') bavl)
 where bavl = A.genOpenBAVL cmp t
       cmp (k',_) = compare k k'

-- | See 'GT' class method 'insertMaybe''.
insertMaybeOrdGT' :: Ord k => (a -> Maybe a) -> k -> a -> OrdGT k a -> OrdGT k a
insertMaybeOrdGT' f k a (OrdGT t) = case A.tryReadBAVL bavl of
                                    Nothing -> a `seq` OrdGT (A.pushBAVL (k,a) bavl)
                                    Just (k',a') -> case f a' of
                                                    Nothing  -> OrdGT (A.deleteBAVL bavl)
                                                    Just a'' -> OrdGT (A.pushBAVL (k',a'') bavl)
 where bavl = A.genOpenBAVL cmp t
       cmp (k',_) = compare k k'

-- | See 'GT' class method 'delete'.
deleteOrdGT :: Ord k => k -> OrdGT k a -> OrdGT k a
deleteOrdGT k (OrdGT t) = OrdGT (A.genDel cmp t)
 where cmp (k',_) = compare k k'
{-# INLINE deleteOrdGT #-}

-- | See 'GT' class method 'deleteMaybe'.
deleteMaybeOrdGT :: Ord k => (a -> Maybe a) -> k -> OrdGT k a -> OrdGT k a
deleteMaybeOrdGT f k (OrdGT t) = OrdGT (A.genDelMaybe cmp t)
 where cmp (k',a) = case compare k k' of
                    LT -> C.Lt
                    EQ -> case f a of
                          Nothing -> C.Eq Nothing
                          Just a' -> C.Eq (Just (k',a'))
                    GT -> C.Gt

-- | See 'GT' class method 'alter'.
alterOrdGT :: Ord k => (Maybe a -> Maybe a) -> k -> OrdGT k a -> OrdGT k a
alterOrdGT f k (OrdGT t) = case A.tryReadBAVL bavl of
                           Nothing     -> OrdGT (doIt k  Nothing ) -- bavl is empty
                           Just (k',a) -> OrdGT (doIt k' (Just a)) -- bavl is full
 where bavl = A.genOpenBAVL cmp t
       cmp (k',_)  = compare k k'
       doIt k' mba = case f mba of
                     Nothing -> A.deleteBAVL bavl       -- This is a nop for empty bavl
                     Just a' -> A.pushBAVL (k',a') bavl -- This is a write for full bavl

-- | See 'GT' class method 'union'.
unionOrdGT :: Ord k => (a -> a -> a) -> OrdGT k a -> OrdGT k a -> OrdGT k a
unionOrdGT f (OrdGT t) (OrdGT t') = OrdGT (A.genUnion cmp t t')
 where cmp (k,a) (k',a') = case compare k k' of
                           LT -> C.Lt
                           EQ -> C.Eq (k, f a a')
                           GT -> C.Gt

-- | See 'GT' class method 'union''.
unionOrdGT' :: Ord k => (a -> a -> a) -> OrdGT k a -> OrdGT k a -> OrdGT k a
unionOrdGT' f (OrdGT t) (OrdGT t') = OrdGT (A.genUnion cmp t t')
 where cmp (k,a) (k',a') = case compare k k' of
                           LT -> C.Lt
                           EQ -> let a'' = f a a' in a'' `seq` C.Eq (k, a'')
                           GT -> C.Gt

-- | See 'GT' class method 'unionMaybe'.
unionMaybeOrdGT :: Ord k => (a -> a -> Maybe a) -> OrdGT k a -> OrdGT k a -> OrdGT k a
unionMaybeOrdGT f (OrdGT t) (OrdGT t') = OrdGT (A.genUnionMaybe cmp t t')
 where cmp (k,a) (k',a') = case compare k k' of
                           LT -> C.Lt
                           EQ -> case f a a' of
                                 Nothing  -> C.Eq Nothing
                                 Just a'' -> C.Eq (Just (k,a''))
                           GT -> C.Gt

-- | See 'GT' class method 'intersection'.
intersectionOrdGT :: Ord k => (a -> b -> c) -> OrdGT k a -> OrdGT k b -> OrdGT k c
intersectionOrdGT f (OrdGT t) (OrdGT t') = OrdGT (A.genIntersection cmp t t')
 where cmp (k,a) (k',b) = case compare k k' of
                          LT -> C.Lt
                          EQ -> C.Eq (k, f a b)
                          GT -> C.Gt

-- | See 'GT' class method 'intersection''.
intersectionOrdGT' :: Ord k => (a -> b -> c) -> OrdGT k a -> OrdGT k b -> OrdGT k c
intersectionOrdGT' f (OrdGT t) (OrdGT t') = OrdGT (A.genIntersection cmp t t')
 where cmp (k,a) (k',b) = case compare k k' of
                          LT -> C.Lt
                          EQ -> let c = f a b in c `seq` C.Eq (k, c)
                          GT -> C.Gt

-- | See 'GT' class method 'intersectionMaybe'.
intersectionMaybeOrdGT :: Ord k => (a -> b -> Maybe c) -> OrdGT k a -> OrdGT k b -> OrdGT k c
intersectionMaybeOrdGT f (OrdGT ta) (OrdGT tb) = OrdGT (A.genIntersectionMaybe cmp ta tb)
 where cmp (k,a) (k',b) = case compare k k' of
                          LT -> C.Lt
                          EQ -> case f a b of
                                Nothing -> C.Eq Nothing
                                Just c  -> C.Eq (Just (k,c))
                          GT -> C.Gt

-- | See 'GT' class method 'difference'.
differenceOrdGT :: Ord k => OrdGT k a -> OrdGT k b -> OrdGT k a
differenceOrdGT (OrdGT t1) (OrdGT t2) = OrdGT (A.genDifference cmp t1 t2)
 where cmp (k,_) (k',_) = compare k k'

-- | See 'GT' class method 'differenceMaybe'.
differenceMaybeOrdGT :: Ord k => (a -> b -> Maybe a) -> OrdGT k a -> OrdGT k b -> OrdGT k a
differenceMaybeOrdGT f (OrdGT ta) (OrdGT tb) = OrdGT (A.genDifferenceMaybe cmp ta tb)
 where cmp (k,a) (k',b) = case compare k k' of
                          LT -> C.Lt
                          EQ -> case f a b of
                                Nothing -> C.Eq Nothing
                                Just a' -> C.Eq (Just (k,a'))
                          GT -> C.Gt

-- | See 'GT' class method 'isSubsetOf'.
isSubsetOfOrdGT :: Ord k => OrdGT k a -> OrdGT k b -> Bool
isSubsetOfOrdGT (OrdGT ta) (OrdGT tb) = A.genIsSubsetOf cmp ta tb
 where cmp (k,_) (k',_) = compare k k'

-- | See 'GT' class method 'isSubmapOf'.
isSubmapOfOrdGT :: Ord k => (a -> b -> Bool) -> OrdGT k a -> OrdGT k b -> Bool
isSubmapOfOrdGT p (OrdGT ta) (OrdGT tb) = A.genIsSubsetOfBy cmp ta tb
 where cmp (k,a) (k',b) = case compare k k' of
                          LT -> C.Lt
                          EQ -> C.Eq $! p a b
                          GT -> C.Gt

-- | See 'GT' class method 'map'.
mapOrdGT :: (a -> b) -> OrdGT k a -> OrdGT k b
-- Note use of strict AVL map! (This does not force evaluation of f a).
mapOrdGT f (OrdGT t) = OrdGT (A.mapAVL' (\(k,a) -> (k,f a)) t)
{-# INLINE mapOrdGT #-}

-- | See 'GT' class method 'map''.
mapOrdGT' :: (a -> b) -> OrdGT k a -> OrdGT k b
mapOrdGT' f (OrdGT t) = OrdGT (A.mapAVL' (\(k,a) -> let b = f a in b `seq` (k,b)) t)
{-# INLINE mapOrdGT' #-}

-- | See 'GT' class method 'mapMaybe'.
mapMaybeOrdGT :: (a -> Maybe b) -> OrdGT k a -> OrdGT k b
mapMaybeOrdGT f (OrdGT t) = OrdGT (A.mapMaybeAVL f' t)
 where f' (k,a) = case f a of
                  Nothing -> Nothing
                  Just b  -> Just (k,b)

-- | See 'GT' class method 'mapWithKey'.
mapWithKeyOrdGT :: (k -> a -> b) -> OrdGT k a -> OrdGT k b
-- Note use of strict AVL map! (This does not force evaluation of f k a).
mapWithKeyOrdGT f (OrdGT t) = OrdGT (A.mapAVL' (\(k,a) -> (k, f k a)) t)
{-# INLINE mapWithKeyOrdGT #-}

-- | See 'GT' class method 'mapWithKey''.
mapWithKeyOrdGT' :: (k -> a -> b) -> OrdGT k a -> OrdGT k b
mapWithKeyOrdGT' f (OrdGT t) = OrdGT (A.mapAVL' (\(k,a) -> let b = f k a in b `seq` (k, b)) t)
{-# INLINE mapWithKeyOrdGT' #-}

-- | See 'GT' class method 'filter'.
filterOrdGT :: (a -> Bool) -> OrdGT k a -> OrdGT k a
filterOrdGT f (OrdGT t) = OrdGT (A.filterAVL (\(_,a) -> f a) t)
{-# INLINE filterOrdGT #-}

-- | See 'GT' class method 'foldrElemsAscending'.
foldrElemsAscendingOrdGT :: (a -> b -> b) -> OrdGT k a -> b -> b
foldrElemsAscendingOrdGT f (OrdGT t) b0 = A.foldrAVL (\(_,a) b -> f a b) b0 t -- Lazy foldr
{-# INLINE foldrElemsAscendingOrdGT #-}

-- | See 'GT' class method 'foldrElemsDescending'.
foldrElemsDescendingOrdGT :: (a -> b -> b) -> OrdGT k a -> b -> b
foldrElemsDescendingOrdGT f (OrdGT t) b0 = A.foldlAVL (\b (_,a) -> f a b) b0 t -- Lazy foldl
{-# INLINE foldrElemsDescendingOrdGT #-}

-- | See 'GT' class method 'foldrKeysAscending'.
foldrKeysAscendingOrdGT :: (k -> b -> b) -> OrdGT k a -> b -> b
foldrKeysAscendingOrdGT f (OrdGT t) b0 = A.foldrAVL (\(k,_) b -> f k b) b0 t -- Lazy foldr
{-# INLINE foldrKeysAscendingOrdGT #-}

-- | See 'GT' class method 'foldrKeysDescending'.
foldrKeysDescendingOrdGT :: (k -> b -> b) -> OrdGT k a -> b -> b
foldrKeysDescendingOrdGT f (OrdGT t) b0 = A.foldlAVL (\b (k,_) -> f k b) b0 t -- Lazy foldl
{-# INLINE foldrKeysDescendingOrdGT #-}

-- | See 'GT' class method 'foldrAssocsAscending'.
foldrAssocsAscendingOrdGT :: (k -> a -> b -> b) -> OrdGT k a -> b -> b
foldrAssocsAscendingOrdGT f (OrdGT t) b0 = A.foldrAVL (\(k,a) b -> f k a b) b0 t -- Lazy foldr
{-# INLINE foldrAssocsAscendingOrdGT #-}

-- | See 'GT' class method 'foldrAssocsDescending'.
foldrAssocsDescendingOrdGT :: (k -> a -> b -> b) -> OrdGT k a -> b -> b
foldrAssocsDescendingOrdGT f (OrdGT t) b0 = A.foldlAVL (\b (k,a) -> f k a b) b0 t -- Lazy foldl
{-# INLINE foldrAssocsDescendingOrdGT #-}

-- | See 'GT' class method 'foldrElemsAscending''.
foldrElemsAscendingOrdGT' :: (a -> b -> b) -> OrdGT k a -> b -> b
foldrElemsAscendingOrdGT' f (OrdGT t) b0 = A.foldrAVL' (\(_,a) b -> f a b) b0 t -- Strict foldr
{-# INLINE foldrElemsAscendingOrdGT' #-}

-- | See 'GT' class method 'foldrElemsDescending''.
foldrElemsDescendingOrdGT' :: (a -> b -> b) -> OrdGT k a -> b -> b
foldrElemsDescendingOrdGT' f (OrdGT t) b0 = A.foldlAVL' (\b (_,a) -> f a b) b0 t -- Strict foldl
{-# INLINE foldrElemsDescendingOrdGT' #-}

-- | See 'GT' class method 'foldrKeysAscending''.
foldrKeysAscendingOrdGT' :: (k -> b -> b) -> OrdGT k a -> b -> b
foldrKeysAscendingOrdGT' f (OrdGT t) b0 = A.foldrAVL' (\(k,_) b -> f k b) b0 t -- Strict foldr
{-# INLINE foldrKeysAscendingOrdGT' #-}

-- | See 'GT' class method 'foldrKeysDescending''.
foldrKeysDescendingOrdGT' :: (k -> b -> b) -> OrdGT k a -> b -> b
foldrKeysDescendingOrdGT' f (OrdGT t) b0 = A.foldlAVL' (\b (k,_) -> f k b) b0 t -- Strict foldl
{-# INLINE foldrKeysDescendingOrdGT' #-}

-- | See 'GT' class method 'foldrAssocsAscending''.
foldrAssocsAscendingOrdGT' :: (k -> a -> b -> b) -> OrdGT k a -> b -> b
foldrAssocsAscendingOrdGT' f (OrdGT t) b0 = A.foldrAVL' (\(k,a) b -> f k a b) b0 t -- Strict foldr
{-# INLINE foldrAssocsAscendingOrdGT' #-}

-- | See 'GT' class method 'foldrAssocsDescending''.
foldrAssocsDescendingOrdGT' :: (k -> a -> b -> b) -> OrdGT k a -> b -> b
foldrAssocsDescendingOrdGT' f (OrdGT t) b0 = A.foldlAVL' (\b (k,a) -> f k a b) b0 t -- Strict foldl
{-# INLINE foldrAssocsDescendingOrdGT' #-}

-- | See 'GT' class method 'foldElemsUINT'.
foldElemsUINTOrdGT :: (a -> UINT -> UINT) -> OrdGT k a -> UINT -> UINT
foldElemsUINTOrdGT f (OrdGT t) n = A.foldrAVL_UINT (\(_,a) u -> f a u) n t
{-# INLINE foldElemsUINTOrdGT #-}

-- | See 'GT' class method 'valid'.
validOrdGT :: Ord k => OrdGT k a -> Maybe String
validOrdGT (OrdGT t) =
 if      A.isSorted (\(k0,_) (k1,_) -> compare k0 k1) t
 then if A.isBalanced t
      then Nothing
      else Just "OrdGT: Tree is not balanced."
 else      Just "OrdGT: Tree is not sorted."

--------------------------------------------------------------------------
--                         OTHER INSTANCES                              --
--------------------------------------------------------------------------

--------
-- Eq --
--------
instance (Eq k, Eq a) => Eq (OrdGT k a) where
 OrdGT t0 == OrdGT t1 = t0 == t1

---------
-- Ord --
---------
instance (Ord k, Ord a) => Ord (OrdGT k a) where
 compare (OrdGT t0) (OrdGT t1) = compare t0 t1

----------
-- Show --
----------
instance (Ord k, Show k, Show a) => Show (OrdGT k a) where
  showsPrec d mp  = showParen (d > 10) $
    showString "fromAssocsAscending " . shows (assocsAscending mp)

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

------------------------
-- Typeable/Typeable1 --
------------------------
instance (Ord k, Typeable k) => Typeable1 (OrdGT k) where
 typeOf1 mp =  mkTyConApp (mkTyCon "Data.Trie.General.OrdGT.OrdGT") [typeOf k]
  where [(k,_)]  = assocsAscending mp -- This is just to get type for k !!
--------------
instance (Typeable1 (OrdGT k), Typeable a) => Typeable (OrdGT k a) where
 typeOf = typeOfDefault

-------------
-- Functor --
-------------
instance Functor (OrdGT k) where
-- fmap :: (a -> b) -> OrdGT k a -> OrdGT k b
   fmap = mapOrdGT -- The lazy version

-----------------
-- Data.Monoid --
-----------------
instance (Ord k, M.Monoid a) => M.Monoid (OrdGT k a) where
-- mempty :: OrdGT k a
   mempty = emptyOrdGT
-- mappend :: OrdGT k a -> OrdGT k a -> OrdGT k a
   mappend map0 map1 = unionOrdGT M.mappend map0 map1
-- mconcat :: [OrdGT k a] -> OrdGT k a
   mconcat maps = L.foldr (unionOrdGT M.mappend) emptyOrdGT maps

-------------------
-- Data.Foldable --
-------------------
instance F.Foldable (OrdGT k) where
-- fold :: Monoid m => OrdGT k m -> m
   fold mp = foldrElemsAscendingOrdGT M.mappend mp M.mempty
-- foldMap :: Monoid m => (a -> m) -> OrdGT k a -> m
   foldMap f mp = foldrElemsAscendingOrdGT (\a b -> M.mappend (f a) b) mp M.mempty
-- foldr :: (a -> b -> b) -> b -> OrdGT k a -> b
   foldr f b0 mp = foldrElemsAscendingOrdGT f mp b0
-- foldl :: (a -> b -> a) -> a -> OrdGT k b -> a
   foldl f b0 mp = foldrElemsDescendingOrdGT (flip f) mp b0
{- ToDo: Implement properly. Meantime Foldable class has suitable defaults via lists.
-- foldr1 :: (a -> a -> a) -> OrdGT k a -> a
   foldr1 = undefined
-- foldl1 :: (a -> a -> a) -> OrdGT k a -> a
   foldl1 = undefined
-}