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

module Data.TrieMap.MultiRec.ConstMap () where

import Data.TrieMap.MultiRec.Class
-- import Data.TrieMap.MultiRec.Eq
-- import Data.TrieMap.MultiRec.Sized
-- import Data.TrieMap.MultiRec.KeyFam
-- import Data.TrieMap.Applicative
import Data.TrieMap.TrieKey
-- import Data.TrieMap.Rep
-- import Data.TrieMap.Rep.TH

import Control.Applicative
import Control.Arrow
import Control.Monad

-- import Data.Maybe
-- import Data.Foldable
import Generics.MultiRec

newtype KMap (phi :: * -> *) m (r :: * -> *) ix a = KMap (m a)
type instance HTrieMapT phi (K k) = KMap phi (TrieMap k)
-- type instance HTrieMap phi (K k r) = HTrieMapT phi (K k) r

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

instance TrieKey k m => HTrieKeyT phi (K k) (KMap phi m) where
	emptyH _ = KMap emptyM
	nullH _ (KMap m) = nullM m
	lookupH _ (K k) (KMap m) = lookupM k m
	lookupIxH _ s (K k) (KMap m) = onKey K (lookupIxM s k m)
	assocAtH _ s i (KMap m) = onKey K (assocAtM s i m)
	alterH _ s f (K k) (KMap m) = KMap (alterM s f k m)
	alterLookupH _ s f (K k) (KMap m) = KMap <$> alterLookupM s f k m
	traverseWithKeyH _ s f (KMap m) = KMap <$> traverseWithKeyM s (f . K) m
	foldWithKeyH _ f (KMap m) = foldWithKeyM (f . K) m
	foldlWithKeyH _ f (KMap m) = foldlWithKeyM (f . K) m
	mapEitherH _ s1 s2 f (KMap m) = (KMap *** KMap) (mapEitherM s1 s2 (f . K) m)
	splitLookupH _ s f (K k) (KMap m) = KMap `sides` splitLookupM s f k m
	unionH _ s f (KMap m1) (KMap m2) = KMap (unionM s (f . K) m1 m2)
	isectH _ s f (KMap m1) (KMap m2) = KMap (isectM s (f . K) m1 m2)
	diffH _ s f (KMap m1) (KMap m2) = KMap (diffM s (f . K) m1 m2)
	extractH _ s f (KMap m) = fmap KMap <$> extractM s (f . K) m
	isSubmapH _ (<=) (KMap m1) (KMap m2) = isSubmapM (<=) m1 m2