{-# LANGUAGE UndecidableInstances, FlexibleInstances, MultiParamTypeClasses, TemplateHaskell, QuasiQuotes #-}

module Data.TrieMap.Regular.TH where

import Data.TrieMap.Regular.Class
import Data.TrieMap.TrieKey
import Language.Haskell.TH

deriveM :: Q [Dec] -> Q [Dec]
deriveM decs = do
	iT@(InstanceD cxt inst _:_) <- decs
	(InstanceD _ _ myDecs:_) <- [d|
	  instance (TrieKeyT f m, Ord (f k), TrieKey k mm) => TrieKey (f k) (m k) where
		emptyM = emptyT
		nullM = nullT
		lookupM = lookupT
		lookupIxM = lookupIxT
		assocAtM = assocAtT
-- 		updateAtM = updateAtT

		alterM = alterT
		alterLookupM = alterLookupT
		traverseWithKeyM = traverseWithKeyT
		foldWithKeyM = foldWithKeyT
		foldlWithKeyM = foldlWithKeyT
		mapEitherM = mapEitherT
		splitLookupM = splitLookupT
		unionM = unionT
		isectM = isectT
		diffM = diffT
		extractM = extractT
-- 		extractMinM = extractMinT
-- 		extractMaxM = extractMaxT
-- 		alterMinM = alterMinT
-- 		alterMaxM = alterMaxT
		isSubmapM = isSubmapT
		fromListM = fromListT
		fromAscListM = fromAscListT
		fromDistAscListM = fromDistAscListT |]
	k <- mkVar "k"
	let triekey = ConT ''TrieKey
	let triemap = ConT ''TrieMap
	let ordT = ConT ''Ord
	return [InstanceD cxt inst myDecs]

mkVar :: String -> TypeQ
mkVar x = varT =<< newName x