{-# OPTIONS_GHC -fglasgow-exts -fno-warn-unused-imports #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Trie.General.UnitGT
-- 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 @'()'@
-----------------------------------------------------------------------------
module Data.Trie.General.UnitGT
(-- * UnitGT type
 UnitGT

 -- * Standard GT API for UnitGTs
 -- | These functions all have the same names as the corresponding GT class methods,
 -- but with the \"UnitGT\" suffix.
,emptyUnitGT
,singletonUnitGT
,fromAssocsAscendingUnitGT
,fromAssocsDescendingUnitGT
,fromAssocsAscendingLUnitGT
,fromAssocsDescendingLUnitGT
,pairUnitGT
,isEmptyUnitGT
,isSingletonUnitGT
,nonEmptyUnitGT
,statusUnitGT
,addSizeUnitGT
,lookupUnitGT
,lookupContUnitGT
,insertUnitGT
,insertUnitGT'
,insertUnitGT''
,insertMaybeUnitGT
,insertMaybeUnitGT'
,deleteUnitGT
,deleteMaybeUnitGT
,alterUnitGT
,unionUnitGT
,unionUnitGT'
,unionMaybeUnitGT
,intersectionUnitGT
,intersectionUnitGT'
,intersectionMaybeUnitGT
,differenceUnitGT
,differenceMaybeUnitGT
,isSubsetOfUnitGT
,isSubmapOfUnitGT
,mapUnitGT
,mapUnitGT'
,mapMaybeUnitGT
,mapWithKeyUnitGT
,mapWithKeyUnitGT'
,filterUnitGT
,foldrElemsAscendingUnitGT
,foldrElemsDescendingUnitGT
,foldrKeysAscendingUnitGT
,foldrKeysDescendingUnitGT
,foldrAssocsAscendingUnitGT
,foldrAssocsDescendingUnitGT
,foldrElemsAscendingUnitGT'
,foldrElemsDescendingUnitGT'
,foldrKeysAscendingUnitGT'
,foldrKeysDescendingUnitGT'
,foldrAssocsAscendingUnitGT'
,foldrAssocsDescendingUnitGT'
,foldElemsUINTUnitGT
,validUnitGT
) 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 default 'GT' type unit (empty tuple) keys.
newtype UnitGT a = UnitGT (Maybe a)

instance GT UnitGT () where
 empty                 = emptyUnitGT
 singleton             = singletonUnitGT
 fromAssocsAscending   = fromAssocsAscendingUnitGT
 fromAssocsDescending  = fromAssocsDescendingUnitGT
 fromAssocsAscendingL  = fromAssocsAscendingLUnitGT
 fromAssocsDescendingL = fromAssocsDescendingLUnitGT
 pair                  = pairUnitGT
 isEmpty               = isEmptyUnitGT
 isSingleton           = isSingletonUnitGT
 nonEmpty              = nonEmptyUnitGT
 status                = statusUnitGT
 addSize               = addSizeUnitGT
 lookup                = lookupUnitGT
 lookupCont            = lookupContUnitGT
 insert                = insertUnitGT
 insert'               = insertUnitGT'
 insert''              = insertUnitGT''
 insertMaybe           = insertMaybeUnitGT
 insertMaybe'          = insertMaybeUnitGT'
 delete                = deleteUnitGT
 deleteMaybe           = deleteMaybeUnitGT
 alter                 = alterUnitGT
 union                 = unionUnitGT
 union'                = unionUnitGT'
 unionMaybe            = unionMaybeUnitGT
 intersection          = intersectionUnitGT
 intersection'         = intersectionUnitGT'
 intersectionMaybe     = intersectionMaybeUnitGT
 difference            = differenceUnitGT
 differenceMaybe       = differenceMaybeUnitGT
 isSubsetOf            = isSubsetOfUnitGT
 isSubmapOf            = isSubmapOfUnitGT
 map                   = mapUnitGT
 map'                  = mapUnitGT'
 mapMaybe              = mapMaybeUnitGT
 mapWithKey            = mapWithKeyUnitGT
 mapWithKey'           = mapWithKeyUnitGT'
 filter                = filterUnitGT
 foldrElemsAscending   = foldrElemsAscendingUnitGT
 foldrElemsDescending  = foldrElemsDescendingUnitGT
 foldrKeysAscending    = foldrKeysAscendingUnitGT
 foldrKeysDescending   = foldrKeysDescendingUnitGT
 foldrAssocsAscending  = foldrAssocsAscendingUnitGT
 foldrAssocsDescending = foldrAssocsDescendingUnitGT
 foldrElemsAscending'  = foldrElemsAscendingUnitGT'
 foldrElemsDescending' = foldrElemsDescendingUnitGT'
 foldrKeysAscending'   = foldrKeysAscendingUnitGT'
 foldrKeysDescending'  = foldrKeysDescendingUnitGT'
 foldrAssocsAscending' = foldrAssocsAscendingUnitGT'
 foldrAssocsDescending'= foldrAssocsDescendingUnitGT'
 foldElemsUINT         = foldElemsUINTUnitGT
 valid                 = validUnitGT

-- | See 'GT' class method 'empty'.
emptyUnitGT :: UnitGT a
emptyUnitGT = UnitGT Nothing
{-# INLINE emptyUnitGT #-}

-- | See 'GT' class method 'singleton'.
singletonUnitGT :: () -> a -> UnitGT a
singletonUnitGT _ a = UnitGT (Just a)
{-# INLINE singletonUnitGT #-}

-- | See 'GT' class method 'fromAssocsAscending'.
fromAssocsAscendingUnitGT :: [((),a)] -> UnitGT a
fromAssocsAscendingUnitGT []        = emptyUnitGT
fromAssocsAscendingUnitGT ((_,a):_) = singletonUnitGT () a

-- | See 'GT' class method 'fromAssocsDescending'.
fromAssocsDescendingUnitGT :: [((),a)] -> UnitGT a
fromAssocsDescendingUnitGT []        = emptyUnitGT
fromAssocsDescendingUnitGT ((_,a):_) = singletonUnitGT () a

-- | See 'GT' class method 'fromAssocsAscendingL'.
fromAssocsAscendingLUnitGT :: Int -> [((),a)] -> UnitGT a
fromAssocsAscendingLUnitGT _ assocs = fromAssocsAscendingUnitGT assocs
{-# INLINE fromAssocsAscendingLUnitGT #-}

-- | See 'GT' class method 'fromAssocsDescendingL'.
fromAssocsDescendingLUnitGT :: Int -> [((),a)] -> UnitGT a
fromAssocsDescendingLUnitGT _ assocs = fromAssocsDescendingUnitGT assocs
{-# INLINE fromAssocsDescendingLUnitGT #-}

-- | See 'GT' class method 'pair'.
pairUnitGT :: () -> () -> Maybe (a -> a -> UnitGT a)
pairUnitGT _ _ = Nothing -- Args are always equal!!
{-# INLINE pairUnitGT #-}

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

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

-- | See 'GT' class method 'nonEmpty'.
nonEmptyUnitGT :: UnitGT a -> Maybe (UnitGT a)
nonEmptyUnitGT (UnitGT Nothing) = Nothing
nonEmptyUnitGT ugt              = Just ugt

-- | See 'GT' class method 'status'.
statusUnitGT :: UnitGT a -> Status () a
statusUnitGT (UnitGT (Just a)) = One () a
statusUnitGT _                 = None

-- | See 'GT' class method 'addSize'.
addSizeUnitGT :: UnitGT a -> UINT -> UINT
addSizeUnitGT (UnitGT Nothing) n = n
addSizeUnitGT _                n = INCINT1(n)

-- | See 'GT' class method 'lookup'.
lookupUnitGT :: () -> UnitGT a -> Maybe a
lookupUnitGT _ (UnitGT mba) = mba
{-# INLINE lookupUnitGT #-}

-- | See 'GT' class method 'lookupCont'.
lookupContUnitGT :: (a -> Maybe b) -> () -> UnitGT a -> Maybe b
lookupContUnitGT f _ (UnitGT (Just a)) = f a
lookupContUnitGT _ _ _                 = Nothing

-- | See 'GT' class method 'insert'.
insertUnitGT :: (a -> a) -> () -> a -> UnitGT a -> UnitGT a
insertUnitGT f _ _  (UnitGT (Just a)) = UnitGT (Just (f a))
insertUnitGT _ _ a' _                 = UnitGT (Just a'   )

-- | See 'GT' class method 'insert''.
insertUnitGT' :: (a -> a) -> () -> a -> UnitGT a -> UnitGT a
insertUnitGT' f _ _  (UnitGT (Just a)) = let a' = f a in a' `seq` UnitGT (Just a')
insertUnitGT' _ _ a' _                 =                          UnitGT (Just a')

-- | See 'GT' class method 'insert'''.
insertUnitGT'' :: (a -> a) -> () -> a -> UnitGT a -> UnitGT a
insertUnitGT'' f _ _  (UnitGT (Just a)) = let a' = f a in a' `seq` UnitGT (Just a')
insertUnitGT'' _ _ a' _                 =                 a' `seq` UnitGT (Just a')

-- | See 'GT' class method 'insertMaybe'.
insertMaybeUnitGT :: (a -> Maybe a) -> () -> a -> UnitGT a -> UnitGT a
insertMaybeUnitGT f _ _  (UnitGT (Just a)) = UnitGT (f a)
insertMaybeUnitGT _ _ a' _                 = UnitGT (Just a')

-- | See 'GT' class method 'insertMaybe''.
insertMaybeUnitGT' :: (a -> Maybe a) -> () -> a -> UnitGT a -> UnitGT a
insertMaybeUnitGT' f _ _  (UnitGT (Just a)) = UnitGT (f a)
insertMaybeUnitGT' _ _ a' _                 = a' `seq` UnitGT (Just a')

-- | See 'GT' class method 'delete'.
deleteUnitGT :: () -> UnitGT a -> UnitGT a
deleteUnitGT _ _ = emptyUnitGT -- Result will always be empty!
{-# INLINE deleteUnitGT #-}

-- | See 'GT' class method 'deleteMaybe'.
deleteMaybeUnitGT :: (a -> Maybe a) -> () -> UnitGT a -> UnitGT a
deleteMaybeUnitGT f _ (UnitGT (Just a)) = UnitGT (f a)
deleteMaybeUnitGT _ _ _                 = emptyUnitGT

-- | See 'GT' class method 'alter'.
alterUnitGT :: (Maybe a -> Maybe a) -> () -> UnitGT a -> UnitGT a
alterUnitGT f _ (UnitGT mba) = UnitGT (f mba)

-- | See 'GT' class method 'union'.
unionUnitGT :: (a -> a -> a) -> UnitGT a -> UnitGT a -> UnitGT a
unionUnitGT _ u@(UnitGT (Just _ ))   (UnitGT Nothing  ) = u
unionUnitGT _   (UnitGT Nothing  ) u@(UnitGT (Just _ )) = u
unionUnitGT f   (UnitGT (Just a0))   (UnitGT (Just a1)) = UnitGT (Just (f a0 a1))
unionUnitGT _ _                    _                    = emptyUnitGT

-- | See 'GT' class method 'union''.
unionUnitGT' :: (a -> a -> a) -> UnitGT a -> UnitGT a -> UnitGT a
unionUnitGT' _ u@(UnitGT (Just _ ))   (UnitGT Nothing  ) = u
unionUnitGT' _   (UnitGT Nothing  ) u@(UnitGT (Just _ )) = u
unionUnitGT' f   (UnitGT (Just a0))   (UnitGT (Just a1)) = let a = f a0 a1 in a `seq` UnitGT (Just a)
unionUnitGT' _ _                    _                    = emptyUnitGT

-- | See 'GT' class method 'unionMaybe'.
unionMaybeUnitGT :: (a -> a -> Maybe a) -> UnitGT a -> UnitGT a -> UnitGT a
unionMaybeUnitGT _ u@(UnitGT (Just _ ))   (UnitGT Nothing  ) = u
unionMaybeUnitGT _   (UnitGT Nothing  ) u@(UnitGT (Just _ )) = u
unionMaybeUnitGT f   (UnitGT (Just a0))   (UnitGT (Just a1)) = UnitGT (f a0 a1)
unionMaybeUnitGT _ _                    _                    = emptyUnitGT

-- | See 'GT' class method 'intersection'.
intersectionUnitGT :: (a -> b -> c) -> UnitGT a -> UnitGT b -> UnitGT c
intersectionUnitGT _ (UnitGT (Just _)) (UnitGT Nothing ) = emptyUnitGT
intersectionUnitGT _ (UnitGT Nothing ) (UnitGT (Just _)) = emptyUnitGT
intersectionUnitGT f (UnitGT (Just a)) (UnitGT (Just b)) = UnitGT (Just (f a b))
intersectionUnitGT _ _                 _                 = emptyUnitGT

-- | See 'GT' class method 'intersection''.
intersectionUnitGT' :: (a -> b -> c) -> UnitGT a -> UnitGT b -> UnitGT c
intersectionUnitGT' _ (UnitGT (Just _)) (UnitGT Nothing ) = emptyUnitGT
intersectionUnitGT' _ (UnitGT Nothing ) (UnitGT (Just _)) = emptyUnitGT
intersectionUnitGT' f (UnitGT (Just a)) (UnitGT (Just b)) = let c = f a b in c `seq` UnitGT (Just c)
intersectionUnitGT' _ _                 _                 = emptyUnitGT

-- | See 'GT' class method 'intersectionMaybe'.
intersectionMaybeUnitGT :: (a -> b -> Maybe c) -> UnitGT a -> UnitGT b -> UnitGT c
intersectionMaybeUnitGT _ (UnitGT (Just _)) (UnitGT Nothing ) = emptyUnitGT
intersectionMaybeUnitGT _ (UnitGT Nothing ) (UnitGT (Just _)) = emptyUnitGT
intersectionMaybeUnitGT f (UnitGT (Just a)) (UnitGT (Just b)) = UnitGT (f a b)
intersectionMaybeUnitGT _ _                   _               = emptyUnitGT

-- | See 'GT' class method 'difference'.
differenceUnitGT :: UnitGT a -> UnitGT b -> UnitGT a
differenceUnitGT u@(UnitGT (Just _)) (UnitGT Nothing) = u
differenceUnitGT   _                 _                = emptyUnitGT

-- | See 'GT' class method 'differenceMaybe'.
differenceMaybeUnitGT :: (a -> b -> Maybe a) -> UnitGT a -> UnitGT b -> UnitGT a
differenceMaybeUnitGT _ u@(UnitGT (Just _)) (UnitGT Nothing ) = u
differenceMaybeUnitGT f   (UnitGT (Just a)) (UnitGT (Just b)) = UnitGT (f a b)
differenceMaybeUnitGT _   _                 _                 = emptyUnitGT

-- | See 'GT' class method 'isSubsetOf'.
isSubsetOfUnitGT :: UnitGT a -> UnitGT b -> Bool
isSubsetOfUnitGT (UnitGT Nothing ) _                  = True
isSubsetOfUnitGT (UnitGT (Just _)) (UnitGT (Just _))  = True
isSubsetOfUnitGT _                 _                  = False

-- | See 'GT' class method 'isSubmapOf'.
isSubmapOfUnitGT :: (a -> b -> Bool) -> UnitGT a -> UnitGT b -> Bool
isSubmapOfUnitGT _ (UnitGT Nothing ) _                  = True
isSubmapOfUnitGT f (UnitGT (Just a)) (UnitGT (Just b))  = f a b
isSubmapOfUnitGT _ _                 _                  = False

-- | See 'GT' class method 'map'.
mapUnitGT :: (a -> b) -> UnitGT a -> UnitGT b
mapUnitGT f (UnitGT (Just a)) = UnitGT (Just (f a))
mapUnitGT _ _                 = emptyUnitGT

-- | See 'GT' class method 'map''.
mapUnitGT' :: (a -> b) -> UnitGT a -> UnitGT b
mapUnitGT' f (UnitGT (Just a)) = let b = f a in b `seq` UnitGT (Just b)
mapUnitGT' _ _                 = emptyUnitGT

-- | See 'GT' class method 'mapMaybe'.
mapMaybeUnitGT :: (a -> Maybe b) -> UnitGT a -> UnitGT b
mapMaybeUnitGT f (UnitGT (Just a)) = UnitGT (f a)
mapMaybeUnitGT _ _                 = emptyUnitGT

-- | See 'GT' class method 'mapWithKey'.
mapWithKeyUnitGT :: (() -> a -> b) -> UnitGT a -> UnitGT b
mapWithKeyUnitGT f (UnitGT (Just a)) = UnitGT (Just (f () a))
mapWithKeyUnitGT _ _                 = emptyUnitGT

-- | See 'GT' class method 'mapWithKey''.
mapWithKeyUnitGT' :: (() -> a -> b) -> UnitGT a -> UnitGT b
mapWithKeyUnitGT' f (UnitGT (Just a)) = let b = f () a in b `seq` UnitGT (Just b)
mapWithKeyUnitGT' _ _                 = emptyUnitGT

-- | See 'GT' class method 'filter'.
filterUnitGT :: (a -> Bool) -> UnitGT a -> UnitGT a
filterUnitGT p u@(UnitGT (Just a)) = if p a then u else emptyUnitGT
filterUnitGT _   _                 = emptyUnitGT

-- | See 'GT' class method 'foldrElemsAscending'.
foldrElemsAscendingUnitGT :: (a -> b -> b) -> UnitGT a -> b -> b
foldrElemsAscendingUnitGT f (UnitGT (Just a)) b = f a b
foldrElemsAscendingUnitGT _ _                 b = b

-- | See 'GT' class method 'foldrElemsDescending'.
foldrElemsDescendingUnitGT :: (a -> b -> b) -> UnitGT a -> b -> b
foldrElemsDescendingUnitGT = foldrElemsAscendingUnitGT
{-# INLINE foldrElemsDescendingUnitGT #-}

-- | See 'GT' class method 'foldrKeysAscending'.
foldrKeysAscendingUnitGT :: (() -> b -> b) -> UnitGT a -> b -> b
foldrKeysAscendingUnitGT f (UnitGT (Just _)) b = f () b
foldrKeysAscendingUnitGT _ _                 b = b

-- | See 'GT' class method 'foldrKeysDescending'.
foldrKeysDescendingUnitGT :: (() -> b -> b) -> UnitGT a -> b -> b
foldrKeysDescendingUnitGT = foldrKeysAscendingUnitGT
{-# INLINE foldrKeysDescendingUnitGT #-}

-- | See 'GT' class method 'foldrAssocsAscending'.
foldrAssocsAscendingUnitGT :: (() -> a -> b -> b) -> UnitGT a -> b -> b
foldrAssocsAscendingUnitGT f (UnitGT (Just a)) b = f () a b
foldrAssocsAscendingUnitGT _ _                 b = b

-- | See 'GT' class method 'foldrAssocsDescending'.
foldrAssocsDescendingUnitGT :: (() -> a -> b -> b) -> UnitGT a -> b -> b
foldrAssocsDescendingUnitGT = foldrAssocsAscendingUnitGT
{-# INLINE foldrAssocsDescendingUnitGT #-}

-- | See 'GT' class method 'foldrElemsAscending''.
foldrElemsAscendingUnitGT' :: (a -> b -> b) -> UnitGT a -> b -> b
foldrElemsAscendingUnitGT' = foldrElemsAscendingUnitGT
{-# INLINE foldrElemsAscendingUnitGT' #-}

-- | See 'GT' class method 'foldrElemsDescending''.
foldrElemsDescendingUnitGT' :: (a -> b -> b) -> UnitGT a -> b -> b
foldrElemsDescendingUnitGT' = foldrElemsDescendingUnitGT
{-# INLINE foldrElemsDescendingUnitGT' #-}

-- | See 'GT' class method 'foldrKeysAscending''.
foldrKeysAscendingUnitGT' :: (() -> b -> b) -> UnitGT a -> b -> b
foldrKeysAscendingUnitGT' = foldrKeysAscendingUnitGT
{-# INLINE foldrKeysAscendingUnitGT' #-}

-- | See 'GT' class method 'foldrKeysDescending''.
foldrKeysDescendingUnitGT' :: (() -> b -> b) -> UnitGT a -> b -> b
foldrKeysDescendingUnitGT' = foldrKeysDescendingUnitGT
{-# INLINE foldrKeysDescendingUnitGT' #-}

-- | See 'GT' class method 'foldrAssocsAscending''.
foldrAssocsAscendingUnitGT' :: (() -> a -> b -> b) -> UnitGT a -> b -> b
foldrAssocsAscendingUnitGT' = foldrAssocsAscendingUnitGT
{-# INLINE foldrAssocsAscendingUnitGT' #-}

-- | See 'GT' class method 'foldrAssocsDescending''.
foldrAssocsDescendingUnitGT' :: (() -> a -> b -> b) -> UnitGT a -> b -> b
foldrAssocsDescendingUnitGT' = foldrAssocsDescendingUnitGT
{-# INLINE foldrAssocsDescendingUnitGT' #-}

-- | See 'GT' class method 'foldElemsUINT'.
foldElemsUINTUnitGT :: (a -> UINT -> UINT) -> UnitGT a -> UINT -> UINT
foldElemsUINTUnitGT f (UnitGT (Just a)) n = f a n
foldElemsUINTUnitGT _ _                 n = n

-- | See 'GT' class method 'valid'.
validUnitGT :: UnitGT a -> Maybe String
validUnitGT _ = Nothing -- Always valid!
{-# INLINE validUnitGT #-}

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

--------
-- Eq --
--------
instance Eq a => Eq (UnitGT a) where
 UnitGT mba0 == UnitGT mba1 = mba0 == mba1

---------
-- Ord --
---------
instance Ord a => Ord (UnitGT a) where
 compare (UnitGT Nothing  ) (UnitGT Nothing  ) = EQ
 compare (UnitGT Nothing  ) (UnitGT (Just _ )) = LT
 compare (UnitGT (Just _ )) (UnitGT Nothing  ) = GT
 compare (UnitGT (Just a0)) (UnitGT (Just a1)) = compare a0 a1

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

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

-------------
-- Functor --
-------------
instance Functor (UnitGT) where
-- fmap :: (a -> b) -> UnitGT a -> UnitGT b
   fmap = mapUnitGT -- The lazy version

-----------------
-- Data.Monoid --
-----------------
instance (M.Monoid a) => M.Monoid (UnitGT a) where
-- mempty :: UnitGT a
   mempty = emptyUnitGT
-- mappend :: UnitGT a -> UnitGT a -> UnitGT a
   mappend map0 map1 = unionUnitGT M.mappend map0 map1
-- mconcat :: [UnitGT a] -> UnitGT a
   mconcat maps = L.foldr (unionUnitGT M.mappend) emptyUnitGT maps

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