{-# OPTIONS_GHC -fglasgow-exts -fno-warn-orphans -fallow-undecidable-instances #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Trie.General.CollectionsInstances.EitherGT
-- Copyright   :  (c) Adrian Hey 2007
-- License     :  BSD3
--
-- Maintainer  :  http://homepages.nildram.co.uk/~ahey/em.png
-- Stability   :  provisional
-- Portability :  Multi-parameter type classes, Functional dependencies
--
-- Instances of the Collections package Classes for the 'EitherGT' type.
-----------------------------------------------------------------------------
module Data.Trie.General.CollectionsInstances.EitherGT
(
) where

import Data.Trie.General.Types (GT(..))
import Data.Trie.General.EitherGT

import qualified Data.Monoid as M (Monoid(..))
import qualified Data.Collections as Coll (Foldable(..),foldr',Unfoldable(..),Collection(..),Map(..))
import qualified Data.Maybe as MB (isJust)

#ifdef __GLASGOW_HASKELL__
import GHC.Base
#include "ghcdefs.h"
#else
#include "h98defs.h"
#endif

-------------------------------
-- Data.Collections.Foldable --
-------------------------------
instance (GT mapL kL, GT mapR kR) => Coll.Foldable (EitherGT mapL mapR (Either kL kR,a)) (Either kL kR,a) where
-- fold :: Monoid (Either kL kR,a) => EitherGT mapL mapR (Either kL kR,a) -> (Either kL kR,a)
   fold mp = foldrElemsAscendingEitherGT (\assoc b -> M.mappend assoc b) mp M.mempty

-- foldMap :: Monoid m => ((Either kL kR,a) -> m) -> EitherGT mapL mapR (Either kL kR,a) -> m
   foldMap f mp = foldrElemsAscendingEitherGT (\assoc b -> M.mappend (f assoc) b) mp M.mempty

-- foldr :: ((Either kL kR,a) -> b -> b) -> b -> EitherGT mapL mapR (Either kL kR,a) -> b
   foldr f b0 mp = foldrElemsAscendingEitherGT (\assoc b -> f assoc b) mp b0

-- foldl :: (b -> (Either kL kR,a) -> b) -> b -> EitherGT mapL mapR (Either kL kR,a) -> b
   foldl f b0 mp = foldrElemsDescendingEitherGT (\assoc b -> f b assoc) mp b0

{- ToDo: Implement properly. Meantime Foldable class has suitable defaults via lists.
-- foldr1 :: ((Either kL kR,a) -> (Either kL kR,a) -> (Either kL kR,a)) -> EitherGT mapL mapR (Either kL kR,a) -> (Either kL kR,a)
-- foldl1 :: ((Either kL kR,a) -> (Either kL kR,a) -> (Either kL kR,a)) -> EitherGT mapL mapR (Either kL kR,a) -> (Either kL kR,a)
-}

-- null :: EitherGT mapL mapR (Either kL kR,a) -> Bool
   null = isEmptyEitherGT

-- size :: EitherGT mapL mapR (Either kL kR,a) -> Int
   size mp = ASINT(addSizeEitherGT mp L(0))

-- isSingleton :: EitherGT mapL mapR (Either kL kR,a) -> Bool
   isSingleton = isSingletonEitherGT
-------------------------------

---------------------------------
-- Data.Collections.Unfoldable --
---------------------------------
instance (GT mapL kL, GT mapR kR) => Coll.Unfoldable (EitherGT mapL mapR (Either kL kR,a)) (Either kL kR,a) where
-- insert :: (Either kL kR,a) -> EitherGT mapL mapR (Either kL kR,a) -> EitherGT mapL mapR (Either kL kR,a)
   insert assoc@(k,_) mp = insertEitherGT' (const assoc) k assoc mp -- Note use of strict insertEitherGT'

-- empty :: EitherGT mapL mapR (Either kL kR,a)
   empty = emptyEitherGT

-- singleton :: (Either kL kR,a) -> EitherGT mapL mapR (Either kL kR,a)
   singleton assoc@(k,_) = singletonEitherGT k assoc

-- insertMany :: Foldable c' (Either kL kR,a) => c' -> EitherGT mapL mapR (Either kL kR,a) -> EitherGT mapL mapR (Either kL kR,a)
   insertMany c mp0 = Coll.foldr (\assoc@(k,_) mp -> insertEitherGT' (const assoc) k assoc mp) mp0 c -- ?? stricness?? l/r??

-- insertManySorted :: Foldable c' (Either kL kR,a) => c' -> EitherGT mapL mapR (Either kL kR,a) -> EitherGT mapL mapR (Either kL kR,a)
   insertManySorted c mp0 = Coll.foldr (\assoc@(k,_) mp -> insertEitherGT' (const assoc) k assoc mp) mp0 c -- How to implement efficiently ??
---------------------------------


---------------------------------
-- Data.Collections.Collection --
---------------------------------
instance (GT mapL kL, GT mapR kR) => Coll.Collection (EitherGT mapL mapR (Either kL kR,a)) (Either kL kR,a) where
-- filter :: ((Either kL kR,a) -> Bool) -> EitherGT mapL mapR (Either kL kR,a) -> EitherGT mapL mapR (Either kL kR,a)
   filter = filterEitherGT
---------------------------------


--------------------------
-- Data.Collections.Map --
--------------------------
-- Needs -fallow-undecidable-instances (coverage condition)
instance (GT mapL kL, GT mapR kR, M.Monoid a) => Coll.Map (EitherGT mapL mapR a) (Either kL kR) a where
-- delete :: Either kL kR -> EitherGT mapL mapR a -> EitherGT mapL mapR a
   delete = deleteEitherGT

-- member :: Either kL kR -> EitherGT mapL mapR a -> Bool
   member k mp = MB.isJust (lookupEitherGT k mp)

-- union :: EitherGT mapL mapR a -> EitherGT mapL mapR a -> EitherGT mapL mapR a
   union = unionEitherGT' (\x _ -> x) -- Note use of strict unionEitherGT'

-- intersection :: EitherGT mapL mapR a -> EitherGT mapL mapR a -> EitherGT mapL mapR a
   intersection = intersectionEitherGT' (\x _ -> x)  -- Note use of strict intersectionEitherGT'

-- difference :: EitherGT mapL mapR a -> EitherGT mapL mapR a -> EitherGT mapL mapR a
   difference = differenceEitherGT

-- isSubset :: EitherGT mapL mapR a -> EitherGT mapL mapR a -> Bool
   isSubset = isSubsetOfEitherGT

-- lookup :: Monad m => Either kL kR -> EitherGT mapL mapR a -> m a
   lookup k mp = case lookupEitherGT k mp of
                 Just a  -> return a
                 Nothing -> fail "Data.Collections.Map.lookup: Key not found in EitherGT."

-- alter :: (Maybe a -> Maybe a) -> Either kL kR -> EitherGT mapL mapR a -> EitherGT mapL mapR a
   alter = alterEitherGT

-- insertWith :: (a -> a -> a) -> Either kL kR -> a -> EitherGT mapL mapR a -> EitherGT mapL mapR a
   insertWith f k a ogt = insertEitherGT (f a) k a ogt

-- fromFoldableWith :: Foldable l (Either kL kR,a) => (a -> a -> a) -> l -> EitherGT mapL mapR a
   fromFoldableWith f l = Coll.foldr insrt emptyEitherGT l  -- Strictness ??
    where insrt (k,a) ogt = insertEitherGT (f a) k a ogt

-- foldGroups :: Foldable l (Either kL kR,b) => (b -> a -> a) -> a -> l -> EitherGT mapL mapR a
   foldGroups f a0 l = Coll.foldr' insrt emptyEitherGT l
    where insrt (k,b) ogt = insertEitherGT (f b) k (f b a0) ogt

-- mapWithKey :: (Either kL kR -> a -> a) -> EitherGT mapL mapR a -> EitherGT mapL mapR a
   mapWithKey = mapWithKeyEitherGT

-- unionWith :: (a -> a -> a) -> EitherGT mapL mapR a -> EitherGT mapL mapR a -> EitherGT mapL mapR a
   unionWith = unionEitherGT

-- intersectionWith :: (a -> a -> a) -> EitherGT mapL mapR a -> EitherGT mapL mapR a -> EitherGT mapL mapR a
   intersectionWith = intersectionEitherGT

-- differenceWith :: (a -> a -> Maybe a) -> EitherGT mapL mapR a -> EitherGT mapL mapR a -> EitherGT mapL mapR a
   differenceWith = differenceMaybeEitherGT

-- isSubmapBy :: (a -> a -> Bool) -> EitherGT mapL mapR a -> EitherGT mapL mapR a -> Bool
   isSubmapBy = isSubmapOfEitherGT
--------------------------