{-# OPTIONS_GHC -fglasgow-exts -fno-warn-orphans #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Trie.General.CollectionsInstances.$TypeName$GT
-- 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 '$TypeName$GT' type.
--
-- This is a textual template to use to create new GT instances by Hand.
-- To use:
--  1- Do appropriate global string substitutions as follows:
--     Basic Type or Class name: $TypeName$  E.G. "List"        ,"Ord"    ,"Bool"
--     Actual Type constructor:  $TypeCons$  E.G. "ListGT map k","OrdGT k","BoolGT"
--     Actual Key Type:          $TypeKey$   E.G. "[k]"         ,"k"      ,"Bool"
--  2- Write code, adding whatever class constraints mey be needed in type sigs.
--  3- Delete this header comment and write something sensible instead.
-----------------------------------------------------------------------------
module Data.Trie.General.CollectionsInstances.$TypeName$GT
(
) where

import Data.Trie.General.Types (GT(..))
import Data.Trie.General.$TypeName$GT

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 Coll.Foldable ($TypeCons$ ($TypeKey$,a)) ($TypeKey$,a) where
-- fold :: Monoid ($TypeKey$,a) => $TypeCons$ ($TypeKey$,a) -> ($TypeKey$,a)
   fold mp = foldrElemsAscending$TypeName$GT (\assoc b -> M.mappend assoc b) mp M.mempty

-- foldMap :: Monoid m => (($TypeKey$,a) -> m) -> $TypeCons$ ($TypeKey$,a) -> m
   foldMap f mp = foldrElemsAscending$TypeName$GT (\assoc b -> M.mappend (f assoc) b) mp M.mempty

-- foldr :: (($TypeKey$,a) -> b -> b) -> b -> $TypeCons$ ($TypeKey$,a) -> b
   foldr f b0 mp = foldrElemsAscending$TypeName$GT (\assoc b -> f assoc b) mp b0

-- foldl :: (b -> ($TypeKey$,a) -> b) -> b -> $TypeCons$ ($TypeKey$,a) -> b
   foldl f b0 mp = foldrElemsDescending$TypeName$GT (\assoc b -> f b assoc) mp b0

{- ToDo: Implement properly. Meantime Foldable class has suitable defaults via lists.
-- foldr1 :: (($TypeKey$,a) -> ($TypeKey$,a) -> ($TypeKey$,a)) -> $TypeCons$ ($TypeKey$,a) -> ($TypeKey$,a)
-- foldl1 :: (($TypeKey$,a) -> ($TypeKey$,a) -> ($TypeKey$,a)) -> $TypeCons$ ($TypeKey$,a) -> ($TypeKey$,a)
-}

-- null :: $TypeCons$ ($TypeKey$,a) -> Bool
   null = isEmpty$TypeName$GT

-- size :: $TypeCons$ ($TypeKey$,a) -> Int
   size mp = ASINT(addSize$TypeName$GT mp L(0))

-- isSingleton :: $TypeCons$ ($TypeKey$,a) -> Bool
   isSingleton = isSingleton$TypeName$GT
-------------------------------

---------------------------------
-- Data.Collections.Unfoldable --
---------------------------------
instance Coll.Unfoldable ($TypeCons$ ($TypeKey$,a)) ($TypeKey$,a) where
-- insert :: ($TypeKey$,a) -> $TypeCons$ ($TypeKey$,a) -> $TypeCons$ ($TypeKey$,a)
   insert assoc@(k,_) mp = insert$TypeName$GT' (const assoc) k assoc mp -- Note use of strict insert$TypeName$GT'

-- empty :: $TypeCons$ ($TypeKey$,a)
   empty = empty$TypeName$GT

-- singleton :: ($TypeKey$,a) -> $TypeCons$ ($TypeKey$,a)
   singleton assoc@(k,_) = singleton$TypeName$GT k assoc

-- insertMany :: Foldable c' ($TypeKey$,a) => c' -> $TypeCons$ ($TypeKey$,a) -> $TypeCons$ ($TypeKey$,a)
   insertMany c mp0 = Coll.foldr (\assoc@(k,_) mp -> insert$TypeName$GT' (const assoc) k assoc mp) mp0 c -- ?? stricness?? l/r??

-- insertManySorted :: Foldable c' ($TypeKey$,a) => c' -> $TypeCons$ ($TypeKey$,a) -> $TypeCons$ ($TypeKey$,a)
   insertManySorted c mp0 = Coll.foldr (\assoc@(k,_) mp -> insert$TypeName$GT' (const assoc) k assoc mp) mp0 c -- How to implement efficiently ??
---------------------------------


---------------------------------
-- Data.Collections.Collection --
---------------------------------
instance Coll.Collection ($TypeCons$ ($TypeKey$,a)) ($TypeKey$,a) where
-- filter :: (($TypeKey$,a) -> Bool) -> $TypeCons$ ($TypeKey$,a) -> $TypeCons$ ($TypeKey$,a)
   filter = filter$TypeName$GT
---------------------------------


--------------------------
-- Data.Collections.Map --
--------------------------
instance (M.Monoid a) => Coll.Map ($TypeCons$ a) ($TypeKey$) a where
-- delete :: $TypeKey$ -> $TypeCons$ a -> $TypeCons$ a
   delete = delete$TypeName$GT

-- member :: $TypeKey$ -> $TypeCons$ a -> Bool
   member k mp = MB.isJust (lookup$TypeName$GT k mp)

-- union :: $TypeCons$ a -> $TypeCons$ a -> $TypeCons$ a
   union = union$TypeName$GT' (\x _ -> x) -- Note use of strict union$TypeName$GT'

-- intersection :: $TypeCons$ a -> $TypeCons$ a -> $TypeCons$ a
   intersection = intersection$TypeName$GT' (\x _ -> x)  -- Note use of strict intersection$TypeName$GT'

-- difference :: $TypeCons$ a -> $TypeCons$ a -> $TypeCons$ a
   difference = difference$TypeName$GT

-- isSubset :: $TypeCons$ a -> $TypeCons$ a -> Bool
   isSubset = isSubsetOf$TypeName$GT

-- lookup :: Monad m => $TypeKey$ -> $TypeCons$ a -> m a
   lookup k mp = case lookup$TypeName$GT k mp of
                 Just a  -> return a
                 Nothing -> fail "Data.Collections.Map.lookup: Key not found in $TypeName$GT."

-- alter :: (Maybe a -> Maybe a) -> $TypeKey$ -> $TypeCons$ a -> $TypeCons$ a
   alter = alter$TypeName$GT

-- insertWith :: (a -> a -> a) -> $TypeKey$ -> a -> $TypeCons$ a -> $TypeCons$ a
   insertWith f k a ogt = insert$TypeName$GT (f a) k a ogt

-- fromFoldableWith :: Foldable l ($TypeKey$,a) => (a -> a -> a) -> l -> $TypeCons$ a
   fromFoldableWith f l = Coll.foldr insrt empty$TypeName$GT l  -- Strictness ??
    where insrt (k,a) ogt = insert$TypeName$GT (f a) k a ogt

-- foldGroups :: Foldable l ($TypeKey$,b) => (b -> a -> a) -> a -> l -> $TypeCons$ a
   foldGroups f a0 l = Coll.foldr' insrt empty$TypeName$GT l
    where insrt (k,b) ogt = insert$TypeName$GT (f b) k (f b a0) ogt

-- mapWithKey :: ($TypeKey$ -> a -> a) -> $TypeCons$ a -> $TypeCons$ a
   mapWithKey = mapWithKey$TypeName$GT

-- unionWith :: (a -> a -> a) -> $TypeCons$ a -> $TypeCons$ a -> $TypeCons$ a
   unionWith = union$TypeName$GT

-- intersectionWith :: (a -> a -> a) -> $TypeCons$ a -> $TypeCons$ a -> $TypeCons$ a
   intersectionWith = intersection$TypeName$GT

-- differenceWith :: (a -> a -> Maybe a) -> $TypeCons$ a -> $TypeCons$ a -> $TypeCons$ a
   differenceWith = differenceMaybe$TypeName$GT

-- isSubmapBy :: (a -> a -> Bool) -> $TypeCons$ a -> $TypeCons$ a -> Bool
   isSubmapBy = isSubmapOf$TypeName$GT
--------------------------