{-# LANGUAGE QuasiQuotes, TemplateHaskell, Rank2Types, TypeFamilies, FlexibleInstances, FlexibleContexts, UndecidableInstances, MultiParamTypeClasses #-}

module Data.TrieMap.MultiRec.IMap () where

import Data.TrieMap.MultiRec.Class
import Data.TrieMap.MultiRec.Sized
import Data.TrieMap.MultiRec.TH
-- import Data.TrieMap.Rep.TH
-- import Data.TrieMap.Rep
import Data.TrieMap.TrieKey

import Control.Applicative
import Control.Arrow

import Generics.MultiRec

newtype IMap phi xi r ix a = IMap (HTrieMap phi r xi a)
type instance HTrieMapT phi (I xi) = IMap phi xi
type instance HTrieMap phi (I xi r) = HTrieMapT phi (I xi) r

-- type instance RepT (IMap phi xi r ix) = RepT (HTrieMap phi r xi)
-- type instance Rep (IMap phi xi r ix a) = RepT (IMap phi xi r ix) (Rep a)
-- 
-- -- $(genRepT [d|
--   instance ReprT (HTrieMap phi r xi) => ReprT (IMap phi xi r ix) where
-- 	toRepT (IMap m) = toRepT m
-- 	fromRepT = IMap . fromRepT |] )


$(inferH [d|
   instance El phi xi => HTrieKeyT phi (I xi) (IMap phi xi) where
	emptyT _ = IMap (emptyH proof)
	nullT _ (IMap m) = nullH proof m
	sizeT _ s (IMap m) = sizeH proof s m
	lookupT _ (I k) (IMap m) = lookupH proof k m
	lookupIxT _ s (I k) (IMap m) = onKey I (lookupIxH proof s k m)
	assocAtT _ s i (IMap m) = onKey I (assocAtH proof s i m)
-- 	updateAtT _ s r f i (IMap m) = IMap (updateAtH proof s r (\ i' -> f i' . I) i m)
	alterT _ s f (I k) (IMap m) = IMap (alterH proof s f k m)
	traverseWithKeyT _ s f (IMap m) = IMap <$> traverseWithKeyH proof s (f . I) m
	foldWithKeyT _ f (IMap m) = foldWithKeyH proof (f . I) m
	foldlWithKeyT _ f (IMap m) = foldlWithKeyH proof (f . I) m
	mapEitherT _ s1 s2 f (IMap m) = (IMap *** IMap) (mapEitherH proof s1 s2 (f . I) m)
	splitLookupT pf s f (I k) (IMap m) = IMap `sides` splitLookupH proof s (f) k m
	unionT pf s f (IMap m1) (IMap m2) = IMap (unionH proof s (f . I) m1 m2)
	isectT pf s f (IMap m1) (IMap m2) = IMap (isectH proof s (f . I) m1 m2)
	diffT pf s f (IMap m1) (IMap m2) = IMap (diffH proof s (f . I) m1 m2)
	extractT pf s f (IMap m) = second IMap <$> extractH proof s (f . I) m
-- 	extractMinT pf s f (IMap m) = second IMap <$> extractMinH proof s (f . I) m
-- 	extractMaxT pf s f (IMap m) = second IMap <$> extractMaxH proof s (f . I) m
-- 	alterMinT pf s f (IMap m) = IMap <$> alterMinH proof s (f . I) m
-- 	alterMaxT pf s f (IMap m) = IMap <$> alterMaxH proof s (f . I) m
	isSubmapT pf (<=) (IMap m1) (IMap m2) = isSubmapH proof (<=) m1 m2 
	fromListT _ s f xs = IMap (fromListH proof s (f . I) [(k, a) | (I k, a) <- xs])
	fromAscListT _ s f xs = IMap (fromAscListH proof s (f . I) [(k, a) | (I k, a) <- xs])
	fromDistAscListT _ s xs = IMap (fromDistAscListH proof s [(k, a) | (I k, a) <- xs]) |])