{-# OPTIONS_GHC -fglasgow-exts -fno-warn-unused-imports #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Trie.General.BoolGT
-- 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 @'Bool'@
--
-- N.B. For 'Bool's ascending order is @['False','True']@
-----------------------------------------------------------------------------
module Data.Trie.General.BoolGT
(-- * BoolGT type
 BoolGT

 -- * Standard GT API for BoolGTs
 -- | These functions all have the same names as the corresponding GT class methods,
 -- but with the \"BoolGT\" suffix.
,emptyBoolGT
,singletonBoolGT
,fromAssocsAscendingBoolGT
,fromAssocsDescendingBoolGT
,fromAssocsAscendingLBoolGT
,fromAssocsDescendingLBoolGT
,pairBoolGT
,isEmptyBoolGT
,isSingletonBoolGT
,nonEmptyBoolGT
,statusBoolGT
,addSizeBoolGT
,lookupBoolGT
,lookupContBoolGT
,insertBoolGT
,insertBoolGT'
,insertBoolGT''
,insertMaybeBoolGT
,insertMaybeBoolGT'
,deleteBoolGT
,deleteMaybeBoolGT
,alterBoolGT
,unionBoolGT
,unionBoolGT'
,unionMaybeBoolGT
,intersectionBoolGT
,intersectionBoolGT'
,intersectionMaybeBoolGT
,differenceBoolGT
,differenceMaybeBoolGT
,isSubsetOfBoolGT
,isSubmapOfBoolGT
,mapBoolGT
,mapBoolGT'
,mapMaybeBoolGT
,mapWithKeyBoolGT
,mapWithKeyBoolGT'
,filterBoolGT
,foldrElemsAscendingBoolGT
,foldrElemsDescendingBoolGT
,foldrKeysAscendingBoolGT
,foldrKeysDescendingBoolGT
,foldrAssocsAscendingBoolGT
,foldrAssocsDescendingBoolGT
,foldrElemsAscendingBoolGT'
,foldrElemsDescendingBoolGT'
,foldrKeysAscendingBoolGT'
,foldrKeysDescendingBoolGT'
,foldrAssocsAscendingBoolGT'
,foldrAssocsDescendingBoolGT'
,foldElemsUINTBoolGT
,validBoolGT
) where

import Data.Trie.General.Types

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)

#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 'GT' type for @'Bool'@ keys.
data BoolGT a = BoolGT !(Maybe a) !(Maybe a)

instance GT BoolGT Bool where
 empty                 = emptyBoolGT
 singleton             = singletonBoolGT
 fromAssocsAscending   = fromAssocsAscendingBoolGT
 fromAssocsDescending  = fromAssocsDescendingBoolGT
 fromAssocsAscendingL  = fromAssocsAscendingLBoolGT
 fromAssocsDescendingL = fromAssocsDescendingLBoolGT
 pair                  = pairBoolGT
 isEmpty               = isEmptyBoolGT
 isSingleton           = isSingletonBoolGT
 nonEmpty              = nonEmptyBoolGT
 status                = statusBoolGT
 addSize               = addSizeBoolGT
 lookup                = lookupBoolGT
 lookupCont            = lookupContBoolGT
 insert                = insertBoolGT
 insert'               = insertBoolGT'
 insert''              = insertBoolGT''
 insertMaybe           = insertMaybeBoolGT
 insertMaybe'          = insertMaybeBoolGT'
 delete                = deleteBoolGT
 deleteMaybe           = deleteMaybeBoolGT
 alter                 = alterBoolGT
 union                 = unionBoolGT
 union'                = unionBoolGT'
 unionMaybe            = unionMaybeBoolGT
 intersection          = intersectionBoolGT
 intersection'         = intersectionBoolGT'
 intersectionMaybe     = intersectionMaybeBoolGT
 difference            = differenceBoolGT
 differenceMaybe       = differenceMaybeBoolGT
 isSubsetOf            = isSubsetOfBoolGT
 isSubmapOf            = isSubmapOfBoolGT
 map                   = mapBoolGT
 map'                  = mapBoolGT'
 mapMaybe              = mapMaybeBoolGT
 mapWithKey            = mapWithKeyBoolGT
 mapWithKey'           = mapWithKeyBoolGT'
 filter                = filterBoolGT
 foldrElemsAscending   = foldrElemsAscendingBoolGT
 foldrElemsDescending  = foldrElemsDescendingBoolGT
 foldrKeysAscending    = foldrKeysAscendingBoolGT
 foldrKeysDescending   = foldrKeysDescendingBoolGT
 foldrAssocsAscending  = foldrAssocsAscendingBoolGT
 foldrAssocsDescending = foldrAssocsDescendingBoolGT
 foldrElemsAscending'  = foldrElemsAscendingBoolGT'
 foldrElemsDescending' = foldrElemsDescendingBoolGT'
 foldrKeysAscending'   = foldrKeysAscendingBoolGT'
 foldrKeysDescending'  = foldrKeysDescendingBoolGT'
 foldrAssocsAscending' = foldrAssocsAscendingBoolGT'
 foldrAssocsDescending'= foldrAssocsDescendingBoolGT'
 foldElemsUINT         = foldElemsUINTBoolGT
 valid                 = validBoolGT

-- | See 'GT' class method 'empty'.
emptyBoolGT :: BoolGT a
emptyBoolGT = BoolGT Nothing Nothing -- False,True !!
{-# INLINE emptyBoolGT #-}

-- | See 'GT' class method 'singleton'.
singletonBoolGT :: Bool -> a -> BoolGT a
singletonBoolGT False a = BoolGT (Just a) Nothing
singletonBoolGT True  a = BoolGT Nothing  (Just a)
{-# INLINE singletonBoolGT #-}

-- | See 'GT' class method 'fromAssocsAscending'.
fromAssocsAscendingBoolGT :: [(Bool,a)] -> BoolGT a
fromAssocsAscendingBoolGT []                = emptyBoolGT
fromAssocsAscendingBoolGT [(bool,a)]        = singletonBoolGT bool a
fromAssocsAscendingBoolGT ((_,af):(_,at):_) = BoolGT (Just af) (Just at)

-- | See 'GT' class method 'fromAssocsDescending'.
fromAssocsDescendingBoolGT :: [(Bool,a)] -> BoolGT a
fromAssocsDescendingBoolGT []                = emptyBoolGT
fromAssocsDescendingBoolGT [(bool,a)]        = singletonBoolGT bool a
fromAssocsDescendingBoolGT ((_,at):(_,af):_) = BoolGT (Just af) (Just at)

-- | See 'GT' class method 'fromAssocsAscendingL'.
fromAssocsAscendingLBoolGT :: Int -> [(Bool,a)] -> BoolGT a
fromAssocsAscendingLBoolGT _ assocs = fromAssocsAscendingBoolGT assocs
{-# INLINE fromAssocsAscendingLBoolGT #-}

-- | See 'GT' class method 'fromAssocsDescendingL'.
fromAssocsDescendingLBoolGT :: Int -> [(Bool,a)] -> BoolGT a
fromAssocsDescendingLBoolGT _ assocs = fromAssocsDescendingBoolGT assocs
{-# INLINE fromAssocsDescendingLBoolGT #-}

-- | See 'GT' class method 'pair'.
pairBoolGT :: Bool -> Bool -> Maybe (a -> a -> BoolGT a)
pairBoolGT False False = Nothing
pairBoolGT False True  = Just (\af at -> BoolGT (Just af) (Just at))
pairBoolGT True  True  = Nothing
pairBoolGT True  False = Just (\at af -> BoolGT (Just af) (Just at))

-- | See 'GT' class method 'isEmpty'.
isEmptyBoolGT :: BoolGT a -> Bool
isEmptyBoolGT (BoolGT Nothing Nothing) = True
isEmptyBoolGT _                        = False

-- | See 'GT' class method 'isSingleton'.
isSingletonBoolGT :: BoolGT a -> Bool
isSingletonBoolGT (BoolGT Nothing (Just _)) = True
isSingletonBoolGT (BoolGT (Just _) Nothing) = True
isSingletonBoolGT _                         = False

-- | See 'GT' class method 'nonEmpty'.
nonEmptyBoolGT :: BoolGT a -> Maybe (BoolGT a)
nonEmptyBoolGT (BoolGT Nothing Nothing) = Nothing
nonEmptyBoolGT bgt                      = Just bgt

-- | See 'GT' class method 'status'.
statusBoolGT :: BoolGT a -> Status Bool a
statusBoolGT (BoolGT Nothing   Nothing  ) = None
statusBoolGT (BoolGT Nothing   (Just at)) = One True  at
statusBoolGT (BoolGT (Just af) Nothing  ) = One False af
statusBoolGT _                            = Many

-- | See 'GT' class method 'addSize'.
addSizeBoolGT :: BoolGT a -> UINT -> UINT
addSizeBoolGT (BoolGT Nothing  Nothing ) n = n
addSizeBoolGT (BoolGT Nothing  (Just _)) n = INCINT1(n)
addSizeBoolGT (BoolGT (Just _) Nothing ) n = INCINT1(n)
addSizeBoolGT _                          n = INCINT2(n)

-- | See 'GT' class method 'lookup'.
lookupBoolGT :: Bool -> BoolGT a -> Maybe a
lookupBoolGT False (BoolGT mbf _  ) = mbf
lookupBoolGT True  (BoolGT _   mbt) = mbt

-- | See 'GT' class method 'lookupCont'.
lookupContBoolGT :: (a -> Maybe b) -> Bool -> BoolGT a -> Maybe b
lookupContBoolGT _ False (BoolGT Nothing   _        ) = Nothing
lookupContBoolGT f False (BoolGT (Just af) _        ) = f af
lookupContBoolGT _ True  (BoolGT _         Nothing  ) = Nothing
lookupContBoolGT f True  (BoolGT _         (Just at)) = f at

-- | See 'GT' class method 'insert'.
insertBoolGT :: (a -> a) -> Bool -> a -> BoolGT a -> BoolGT a
insertBoolGT _ False af (BoolGT Nothing   mbt      ) = BoolGT (Just af    ) mbt
insertBoolGT f False _  (BoolGT (Just af) mbt      ) = BoolGT (Just (f af)) mbt
insertBoolGT _ True  at (BoolGT mbf       Nothing  ) = BoolGT mbf           (Just at    )
insertBoolGT f True  _  (BoolGT mbf       (Just at)) = BoolGT mbf           (Just (f at))

-- | See 'GT' class method 'insert''.
insertBoolGT' :: (a -> a) -> Bool -> a -> BoolGT a -> BoolGT a
insertBoolGT' _ False af (BoolGT Nothing   mbt      ) =                             BoolGT (Just af ) mbt
insertBoolGT' f False _  (BoolGT (Just af) mbt      ) = let af' = f af in af' `seq` BoolGT (Just af') mbt
insertBoolGT' _ True  at (BoolGT mbf       Nothing  ) =                             BoolGT mbf (Just at )
insertBoolGT' f True  _  (BoolGT mbf       (Just at)) = let at' = f at in at' `seq` BoolGT mbf (Just at')

-- | See 'GT' class method 'insert'''.
insertBoolGT'' :: (a -> a) -> Bool -> a -> BoolGT a -> BoolGT a
insertBoolGT'' _ False af (BoolGT Nothing   mbt      ) =                   af  `seq` BoolGT (Just af ) mbt
insertBoolGT'' f False _  (BoolGT (Just af) mbt      ) = let af' = f af in af' `seq` BoolGT (Just af') mbt
insertBoolGT'' _ True  at (BoolGT mbf       Nothing  ) =                   at  `seq` BoolGT mbf (Just at )
insertBoolGT'' f True  _  (BoolGT mbf       (Just at)) = let at' = f at in at' `seq` BoolGT mbf (Just at')

-- | See 'GT' class method 'insertMaybe'.
insertMaybeBoolGT :: (a -> Maybe a) -> Bool -> a -> BoolGT a -> BoolGT a
insertMaybeBoolGT _ False af (BoolGT Nothing   mbt      ) = BoolGT (Just af) mbt
insertMaybeBoolGT f False _  (BoolGT (Just af) mbt      ) = BoolGT (f af)    mbt
insertMaybeBoolGT _ True  at (BoolGT mbf       Nothing  ) = BoolGT mbf       (Just at)
insertMaybeBoolGT f True  _  (BoolGT mbf       (Just at)) = BoolGT mbf       (f at)

-- | See 'GT' class method 'insertMaybe''.
insertMaybeBoolGT' :: (a -> Maybe a) -> Bool -> a -> BoolGT a -> BoolGT a
insertMaybeBoolGT' _ False af (BoolGT Nothing   mbt      ) = af  `seq` BoolGT (Just af) mbt
insertMaybeBoolGT' f False _  (BoolGT (Just af) mbt      ) =           BoolGT (f af)    mbt
insertMaybeBoolGT' _ True  at (BoolGT mbf       Nothing  ) = at  `seq` BoolGT mbf       (Just at)
insertMaybeBoolGT' f True  _  (BoolGT mbf       (Just at)) =           BoolGT mbf       (f at)

-- | See 'GT' class method 'delete'.
deleteBoolGT :: Bool -> BoolGT a -> BoolGT a
deleteBoolGT False (BoolGT _   mbt) = BoolGT Nothing mbt
deleteBoolGT True  (BoolGT mbf _  ) = BoolGT mbf     Nothing

-- | See 'GT' class method 'deleteMaybe'.
deleteMaybeBoolGT :: (a -> Maybe a) -> Bool -> BoolGT a -> BoolGT a
deleteMaybeBoolGT _ False bgt@(BoolGT Nothing   _        ) = bgt
deleteMaybeBoolGT f False     (BoolGT (Just af) mbt      ) = BoolGT (f af) mbt
deleteMaybeBoolGT _ True  bgt@(BoolGT _         Nothing  ) = bgt
deleteMaybeBoolGT f True      (BoolGT mbf       (Just at)) = BoolGT mbf (f at)

-- | See 'GT' class method 'alter'.
alterBoolGT :: (Maybe a -> Maybe a) -> Bool -> BoolGT a -> BoolGT a
alterBoolGT f False (BoolGT mbf mbt) = BoolGT (f mbf) mbt
alterBoolGT f True  (BoolGT mbf mbt) = BoolGT mbf     (f mbt)

-- | See 'GT' class method 'union'.
unionBoolGT :: (a -> a -> a) -> BoolGT a -> BoolGT a -> BoolGT a
unionBoolGT f (BoolGT mbf0 mbt0) (BoolGT mbf1 mbt1) = BoolGT (u mbf0 mbf1) (u mbt0 mbt1)
 where u Nothing   mb1       = mb1
       u mb0       Nothing   = mb0
       u (Just a0) (Just a1) = Just (f a0 a1)

-- | See 'GT' class method 'union''.
unionBoolGT' :: (a -> a -> a) -> BoolGT a -> BoolGT a -> BoolGT a
unionBoolGT' f (BoolGT mbf0 mbt0) (BoolGT mbf1 mbt1) = BoolGT (u mbf0 mbf1) (u mbt0 mbt1)
 where u Nothing   mb1       = mb1
       u mb0       Nothing   = mb0
       u (Just a0) (Just a1) = let a = f a0 a1 in a `seq` Just a

-- | See 'GT' class method 'unionMaybe'.
unionMaybeBoolGT :: (a -> a -> Maybe a) -> BoolGT a -> BoolGT a -> BoolGT a
unionMaybeBoolGT f (BoolGT mbf0 mbt0) (BoolGT mbf1 mbt1) = BoolGT (u mbf0 mbf1) (u mbt0 mbt1)
 where u Nothing   mb1       = mb1
       u mb0       Nothing   = mb0
       u (Just a0) (Just a1) = f a0 a1

-- | See 'GT' class method 'intersection'.
intersectionBoolGT :: (a -> b -> c) -> BoolGT a -> BoolGT b -> BoolGT c
intersectionBoolGT f (BoolGT mbfa mbta) (BoolGT mbfb mbtb) = BoolGT (i mbfa mbfb) (i mbta mbtb)
 where i Nothing  _        = Nothing
       i _        Nothing  = Nothing
       i (Just a) (Just b) = Just (f a b)

-- | See 'GT' class method 'intersection''.
intersectionBoolGT' :: (a -> b -> c) -> BoolGT a -> BoolGT b -> BoolGT c
intersectionBoolGT' f (BoolGT mbfa mbta) (BoolGT mbfb mbtb) = BoolGT (i mbfa mbfb) (i mbta mbtb)
 where i Nothing  _        = Nothing
       i _        Nothing  = Nothing
       i (Just a) (Just b) = let c = f a b in c `seq` Just c

-- | See 'GT' class method 'intersectionMaybe'.
intersectionMaybeBoolGT :: (a -> b -> Maybe c) -> BoolGT a -> BoolGT b -> BoolGT c
intersectionMaybeBoolGT f (BoolGT mbfa mbta) (BoolGT mbfb mbtb) = BoolGT (i mbfa mbfb) (i mbta mbtb)
 where i Nothing  _        = Nothing
       i _        Nothing  = Nothing
       i (Just a) (Just b) = f a b

-- | See 'GT' class method 'difference'.
differenceBoolGT :: BoolGT a -> BoolGT b -> BoolGT a
differenceBoolGT (BoolGT mbfa mbta) (BoolGT mbfb mbtb) = BoolGT (d mbfa mbfb) (d mbta mbtb)
 where d mba Nothing  = mba
       d _   (Just _) = Nothing

-- | See 'GT' class method 'differenceMaybe'.
differenceMaybeBoolGT :: (a -> b -> Maybe a) -> BoolGT a -> BoolGT b -> BoolGT a
differenceMaybeBoolGT f (BoolGT mbfa mbta) (BoolGT mbfb mbtb) = BoolGT (d mbfa mbfb) (d mbta mbtb)
 where d mba       Nothing = mba
       d Nothing  (Just _) = Nothing
       d (Just a) (Just b) = f a b

-- | See 'GT' class method 'isSubsetOf'.
isSubsetOfBoolGT :: BoolGT a -> BoolGT b -> Bool
isSubsetOfBoolGT (BoolGT mbfa mbta) (BoolGT mbfb mbtb) = (i mbfa mbfb) && (i mbta mbtb)
 where i (Just _) Nothing = False
       i _        _       = True

-- | See 'GT' class method 'isSubmapOf'.
isSubmapOfBoolGT :: (a -> b -> Bool) -> BoolGT a -> BoolGT b -> Bool
isSubmapOfBoolGT f (BoolGT mbfa mbta) (BoolGT mbfb mbtb) = (i mbfa mbfb) && (i mbta mbtb)
 where i (Just _) Nothing  = False
       i (Just a) (Just b) = f a b
       i _        _        = True

-- | See 'GT' class method 'map'.
mapBoolGT :: (a -> b) -> BoolGT a -> BoolGT b
mapBoolGT f (BoolGT mbf mbt) = BoolGT (m mbf) (m mbt) where
 m Nothing  = Nothing
 m (Just a) = Just (f a)

-- | See 'GT' class method 'map''.
mapBoolGT' :: (a -> b) -> BoolGT a -> BoolGT b
mapBoolGT' f (BoolGT mbf mbt) = BoolGT (m mbf) (m mbt) where
 m Nothing  = Nothing
 m (Just a) = let b = f a in b `seq` Just b

-- | See 'GT' class method 'mapMaybe'.
mapMaybeBoolGT :: (a -> Maybe b) -> BoolGT a -> BoolGT b
mapMaybeBoolGT f (BoolGT mbf mbt) = BoolGT (m mbf) (m mbt) where
 m Nothing  = Nothing
 m (Just a) = f a

-- | See 'GT' class method 'mapWithKey'.
mapWithKeyBoolGT :: (Bool -> a -> b) -> BoolGT a -> BoolGT b
mapWithKeyBoolGT f (BoolGT mbf mbt) = BoolGT (m False mbf) (m True mbt) where
 m _ Nothing  = Nothing
 m k (Just a) = Just (f k a)

-- | See 'GT' class method 'mapWithKey''.
mapWithKeyBoolGT' :: (Bool -> a -> b) -> BoolGT a -> BoolGT b
mapWithKeyBoolGT' f (BoolGT mbf mbt) = BoolGT (m False mbf) (m True mbt) where
 m _ Nothing  = Nothing
 m k (Just a) = let b = f k a in b `seq` Just b

-- | See 'GT' class method 'filter'.
filterBoolGT :: (a -> Bool) -> BoolGT a -> BoolGT a
filterBoolGT p (BoolGT mbf mbt) = BoolGT (f mbf) (f mbt)
 where f   Nothing  = Nothing
       f j@(Just a) = if p a then j else Nothing

-- | See 'GT' class method 'foldrElemsAscending'.
foldrElemsAscendingBoolGT :: (a -> b -> b) -> BoolGT a -> b -> b
foldrElemsAscendingBoolGT f (BoolGT mbf mbt) b = g mbf mbt
 where g Nothing   Nothing   = b
       g Nothing   (Just at) = f at b
       g (Just af) Nothing   = f af b
       g (Just af) (Just at) = f af (f at b)

-- | See 'GT' class method 'foldrElemsDescending'.
foldrElemsDescendingBoolGT :: (a -> b -> b) -> BoolGT a -> b -> b
foldrElemsDescendingBoolGT f (BoolGT mbf mbt) b = g mbf mbt
 where g Nothing   Nothing   = b
       g Nothing   (Just at) = f at b
       g (Just af) Nothing   = f af b
       g (Just af) (Just at) = f at (f af b)

-- | See 'GT' class method 'foldrKeysAscending'.
foldrKeysAscendingBoolGT :: (Bool -> b -> b) -> BoolGT a -> b -> b
foldrKeysAscendingBoolGT f (BoolGT mbf mbt) b = g mbf mbt
 where g Nothing  Nothing  = b
       g Nothing  (Just _) = f True b
       g (Just _) Nothing  = f False b
       g (Just _) (Just _) = f False (f True b)

-- | See 'GT' class method 'foldrKeysDescending'.
foldrKeysDescendingBoolGT :: (Bool -> b -> b) -> BoolGT a -> b -> b
foldrKeysDescendingBoolGT f (BoolGT mbf mbt) b = g mbf mbt
 where g Nothing  Nothing  = b
       g Nothing  (Just _) = f True b
       g (Just _) Nothing  = f False b
       g (Just _) (Just _) = f True (f False b)

-- | See 'GT' class method 'foldrAssocsAscending'.
foldrAssocsAscendingBoolGT :: (Bool -> a -> b -> b) -> BoolGT a -> b -> b
foldrAssocsAscendingBoolGT f (BoolGT mbf mbt) b = g mbf mbt
 where g Nothing   Nothing   = b
       g Nothing   (Just at) = f True  at b
       g (Just af) Nothing   = f False af b
       g (Just af) (Just at) = f False af (f True at b)

-- | See 'GT' class method 'foldrAssocsDescending'.
foldrAssocsDescendingBoolGT :: (Bool -> a -> b -> b) -> BoolGT a -> b -> b
foldrAssocsDescendingBoolGT f (BoolGT mbf mbt) b = g mbf mbt
 where g Nothing   Nothing   = b
       g Nothing   (Just at) = f True  at b
       g (Just af) Nothing   = f False af b
       g (Just af) (Just at) = f True  at (f False af b)

-- | See 'GT' class method 'foldrElemsAscending''.
foldrElemsAscendingBoolGT' :: (a -> b -> b) -> BoolGT a -> b -> b
foldrElemsAscendingBoolGT' f (BoolGT mbf mbt) b = g mbf mbt
 where g Nothing   Nothing   = b
       g Nothing   (Just at) = f at b
       g (Just af) Nothing   = f af b
       g (Just af) (Just at) = f af $! f at b

-- | See 'GT' class method 'foldrElemsDescending''.
foldrElemsDescendingBoolGT' :: (a -> b -> b) -> BoolGT a -> b -> b
foldrElemsDescendingBoolGT' f (BoolGT mbf mbt) b = g mbf mbt
 where g Nothing   Nothing   = b
       g Nothing   (Just at) = f at b
       g (Just af) Nothing   = f af b
       g (Just af) (Just at) = f at $! f af b

-- | See 'GT' class method 'foldrKeysAscending''.
foldrKeysAscendingBoolGT' :: (Bool -> b -> b) -> BoolGT a -> b -> b
foldrKeysAscendingBoolGT' f (BoolGT mbf mbt) b = g mbf mbt
 where g Nothing  Nothing  = b
       g Nothing  (Just _) = f True b
       g (Just _) Nothing  = f False b
       g (Just _) (Just _) = f False $! f True b

-- | See 'GT' class method 'foldrKeysDescending''.
foldrKeysDescendingBoolGT' :: (Bool -> b -> b) -> BoolGT a -> b -> b
foldrKeysDescendingBoolGT' f (BoolGT mbf mbt) b = g mbf mbt
 where g Nothing  Nothing  = b
       g Nothing  (Just _) = f True b
       g (Just _) Nothing  = f False b
       g (Just _) (Just _) = f True $! f False b

-- | See 'GT' class method 'foldrAssocsAscending''.
foldrAssocsAscendingBoolGT' :: (Bool -> a -> b -> b) -> BoolGT a -> b -> b
foldrAssocsAscendingBoolGT' f (BoolGT mbf mbt) b = g mbf mbt
 where g Nothing   Nothing   = b
       g Nothing   (Just at) = f True  at b
       g (Just af) Nothing   = f False af b
       g (Just af) (Just at) = f False af $! f True at b

-- | See 'GT' class method 'foldrAssocsDescending''.
foldrAssocsDescendingBoolGT' :: (Bool -> a -> b -> b) -> BoolGT a -> b -> b
foldrAssocsDescendingBoolGT' f (BoolGT mbf mbt) b = g mbf mbt
 where g Nothing   Nothing   = b
       g Nothing   (Just at) = f True  at b
       g (Just af) Nothing   = f False af b
       g (Just af) (Just at) = f True at $! f False af b

-- | See 'GT' class method 'foldElemsUINT'.
foldElemsUINTBoolGT :: (a -> UINT -> UINT) -> BoolGT a -> UINT -> UINT
foldElemsUINTBoolGT f (BoolGT mbf mbt) n = g mbf mbt
#ifdef __GLASGOW_HASKELL__
 where g Nothing   Nothing   = n
       g Nothing   (Just at) = f at n
       g (Just af) Nothing   = f af n
       g (Just af) (Just at) = f af (f at n)
#else
 where g Nothing   Nothing   = n
       g Nothing   (Just at) = f at n
       g (Just af) Nothing   = f af n
       g (Just af) (Just at) = f af $! (f at n)
#endif

-- | See 'GT' class method 'valid'.
validBoolGT :: BoolGT a -> Maybe String
validBoolGT _ = Nothing -- There are no invalid BoolGTs
{-# INLINE validBoolGT #-}

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

--------
-- Eq --
--------
instance Eq a => Eq (BoolGT a) where
 BoolGT mbf0 mbt0 == BoolGT mbf1 mbt1 = (mbf0 == mbf1) && (mbt0 == mbt1)

---------
-- Ord --
---------
instance Ord a => Ord (BoolGT a) where
 compare (BoolGT mbf0' mbt0') (BoolGT mbf1' mbt1') = c mbf0' mbf1' mbt0' mbt1' where
  c Nothing    Nothing    mbt0       mbt1     = c' mbt0 mbt1
  c Nothing    (Just _  ) Nothing    _        = LT
  c Nothing    (Just _  ) (Just _  ) _        = GT
  c (Just _  ) Nothing    _          Nothing  = GT
  c (Just _  ) Nothing    _          (Just _) = LT
  c (Just af0) (Just af1) mbt0       mbt1 = case compare af0 af1 of
                                            LT -> LT
                                            EQ -> c' mbt0 mbt1
                                            GT -> GT
  c' Nothing    Nothing    = EQ
  c' Nothing    (Just _  ) = LT
  c' (Just _  ) Nothing    = GT
  c' (Just at0) (Just at1) = compare at0 at1

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

----------
-- Read --
----------
#ifdef __GLASGOW_HASKELL__
instance R.Read a => R.Read (BoolGT 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 R.Read a => Read (BoolGT 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 Typeable1 BoolGT where
 typeOf1 _ = mkTyConApp (mkTyCon "Data.Trie.General.BoolGT.BoolGT") []
--------------
instance Typeable a => Typeable (BoolGT a) where
 typeOf = typeOfDefault

-------------
-- Functor --
-------------
instance Functor BoolGT where
-- fmap :: (a -> b) -> BoolGT a -> BoolGT b
   fmap = mapBoolGT -- The lazy version

-----------------
-- Data.Monoid --
-----------------
instance M.Monoid a => M.Monoid (BoolGT a) where
-- mempty :: BoolGT a
   mempty = emptyBoolGT
-- mappend :: BoolGT a -> BoolGT a -> BoolGT a
   mappend map0 map1 = unionBoolGT M.mappend map0 map1
-- mconcat :: [BoolGT a] -> BoolGT a
   mconcat maps = L.foldr (unionBoolGT M.mappend) emptyBoolGT maps

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